(* ========================================================================= *)
(*                                                                           *)
(*           Henstock-Kurzweil (gauge) Integration (univariate)              *)
(*                                                                           *)
(*        (c) Copyright, John Harrison 1998-2008                             *)
(*        (c) Copyright, Marco Maggesi 2014                                  *)
(*        (c) Copyright 2015,                                                *)
(*                       Muhammad Qasim,                                     *)
(*                       Osman Hasan,                                        *)
(*                       Hardware Verification Group,                        *)
(*                       Concordia University                                *)
(*            Contact:  <m_qasi@ece.concordia.ca>                            *)
(*                                                                           *)
(*    Note: This theory was ported from HOL Light                            *)
(*                                                                           *)
(* ========================================================================= *)

open HolKernel Parse boolLib bossLib;

open numTheory numLib unwindLib tautLib Arith prim_recTheory pairTheory
     combinTheory quotientTheory arithmeticTheory pred_setTheory realTheory
     realLib jrhUtils seqTheory limTheory transcTheory listTheory mesonLib
     topologyTheory optionTheory RealArith pred_setLib cardinalTheory;

open hurdUtils iterateTheory real_topologyTheory derivativeTheory;

val _ = new_theory "integration";

val std_ss = std_ss -* ["lift_disj_eq", "lift_imp_disj"]
val real_ss = real_ss -* ["lift_disj_eq", "lift_imp_disj"]
val _ = temp_delsimps ["lift_disj_eq", "lift_imp_disj"]

fun MESON ths tm = prove(tm,MESON_TAC ths);
fun METIS ths tm = prove(tm,METIS_TAC ths);

val DISC_RW_KILL = DISCH_TAC THEN ONCE_ASM_REWRITE_TAC [] THEN
                   POP_ASSUM K_TAC;

fun ASSERT_TAC tm = SUBGOAL_THEN tm STRIP_ASSUME_TAC;
val ASM_ARITH_TAC = REPEAT (POP_ASSUM MP_TAC) THEN ARITH_TAC;

(* Minimal hol-light compatibility layer *)
val ASM_REAL_ARITH_TAC = REAL_ASM_ARITH_TAC; (* RealArith *)
val IMP_CONJ           = CONJ_EQ_IMP;        (* cardinalTheory *)
val FINITE_SUBSET      = SUBSET_FINITE_I;    (* pred_setTheory *)
val LE_0               = ZERO_LESS_EQ;       (* arithmeticTheory *)
val SUM_LE             = SUM_MONO_LE;        (* iterateTheory *)

(* --------------------------------------------------------------------- *)
(* STRONG_DISJ2_TAC : tactic                                             *)
(*                                                                       *)
(* If the goal is (asms, A \/ B) then the tactic returns a subgoal of    *)
(* the form ((~A)::asms, B)                                              *)
(* --------------------------------------------------------------------- *)
local
  val th = prove (``!a b. (~a ==> b) ==> a \/ b``, PROVE_TAC [])
in
  val STRONG_DISJ2_TAC :tactic = MATCH_MP_TAC th >> DISCH_TAC
end;

(* ------------------------------------------------------------------------- *)
(* Some useful lemmas about intervals.                                       *)
(* ------------------------------------------------------------------------- *)

val INTERIOR_SUBSET_UNION_INTERVALS = store_thm ("INTERIOR_SUBSET_UNION_INTERVALS",
 ``!s i j. (?a b:real. i = interval[a,b]) /\ (?c d. j = interval[c,d]) /\
           ~(interior j = {}) /\
           i SUBSET j UNION s /\
           (interior(i) INTER interior(j) = {})
           ==> interior i SUBSET interior s``,
  REPEAT STRIP_TAC THEN FULL_SIMP_TAC std_ss [] THEN
  MATCH_MP_TAC INTERIOR_MAXIMAL THEN REWRITE_TAC[OPEN_INTERIOR] THEN
  POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
  ASM_REWRITE_TAC [] THEN REPEAT STRIP_TAC THEN
  RULE_ASSUM_TAC(REWRITE_RULE[INTERIOR_CLOSED_INTERVAL]) THEN
  SUBGOAL_THEN ``interval(a:real,b) INTER interval[c,d] = {}`` ASSUME_TAC THENL
   [ASM_SIMP_TAC std_ss [INTER_INTERVAL_MIXED_EQ_EMPTY],
    MP_TAC(ISPECL [``a:real``, ``b:real``] INTERVAL_OPEN_SUBSET_CLOSED) THEN
    REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN
    REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]]);

val lemma1 = Q.prove (
   `(abs(d:real) = e / &2) ==>
        dist(x + d,y) < e / &2 ==> dist(x,y) < e`,
  GEN_REWR_TAC LAND_CONV [EQ_SYM_EQ] THEN DISCH_TAC THEN
  GEN_REWR_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_HALF_DOUBLE] THEN
  ASM_REWRITE_TAC [dist] THEN REAL_ARITH_TAC);

val lemma2 = Q.prove (
   `!x:real. (-x/2) = -(x/2)`,
 GEN_TAC THEN ONCE_REWRITE_TAC [REAL_NEG_MINUS1] THEN
 REWRITE_TAC [real_div, REAL_MUL_ASSOC]);

val INTER_INTERIOR_BIGUNION_INTERVALS = store_thm ("INTER_INTERIOR_BIGUNION_INTERVALS",
 ``!s f. FINITE f /\ open s /\
         (!t. t IN f ==> ?a b:real. (t = interval[a,b])) /\
         (!t. t IN f ==> (s INTER (interior t) = {}))
         ==> (s INTER interior(BIGUNION f) = {})``,
  ONCE_REWRITE_TAC[TAUT
    `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> ~e ==> ~d`] THEN
  SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP, GSYM MEMBER_NOT_EMPTY] THEN
  SIMP_TAC std_ss [OPEN_CONTAINS_BALL_EQ, OPEN_INTER, OPEN_INTERIOR] THEN
  SIMP_TAC std_ss [OPEN_SUBSET_INTERIOR, OPEN_BALL, SUBSET_INTER] THEN
  REWRITE_TAC[GSYM SUBSET_INTER] THEN
  GEN_TAC THEN ONCE_REWRITE_TAC[GSYM AND_IMP_INTRO] THEN GEN_TAC THEN
  KNOW_TAC ``(open s /\ (!t. t IN f ==> ?a b. t = interval [(a,b)]) ==>
        (?x e. 0 < e /\ ball (x,e) SUBSET s INTER BIGUNION f) ==>
          ?t. t IN f /\ ?x e. 0 < e /\ ball (x,e) SUBSET s INTER t) =
        (\f. (open s /\ (!t. t IN f ==> ?a b. t = interval [(a,b)]) ==>
        (?x e. 0 < e /\ ball (x,e) SUBSET s INTER BIGUNION f) ==>
          ?t. t IN f /\ ?x e. 0 < e /\ ball (x,e) SUBSET s INTER t))f`` THENL
  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN CONJ_TAC THENL
   [REWRITE_TAC[BIGUNION_EMPTY, INTER_EMPTY, SUBSET_EMPTY] THEN
    MESON_TAC[CENTRE_IN_BALL, NOT_IN_EMPTY],
    ALL_TAC] THEN
  SIMP_TAC std_ss [GSYM RIGHT_FORALL_IMP_THM] THEN
  MAP_EVERY X_GEN_TAC [``f:(real->bool)->bool``, ``i:real->bool``] THEN
  DISCH_TAC THEN DISCH_TAC THEN
  REWRITE_TAC[BIGUNION_INSERT, IN_INSERT] THEN
  REWRITE_TAC[TAUT `(a \/ b) ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
  SIMP_TAC std_ss [RIGHT_AND_OVER_OR, FORALL_AND_THM, EXISTS_OR_THM] THEN
  SIMP_TAC std_ss [GSYM CONJ_ASSOC, UNWIND_THM2] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN ``a:real`` (X_CHOOSE_THEN ``b:real``
    SUBST_ALL_TAC)) THEN
  FIRST_X_ASSUM(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT
   `(r ==> s \/ p) ==> (p ==> q) ==> r ==> s \/ q`) THEN
  POP_ASSUM_LIST(K ALL_TAC) THEN
  DISCH_THEN (X_CHOOSE_TAC ``x:real``) THEN POP_ASSUM MP_TAC THEN
  DISCH_THEN (X_CHOOSE_TAC ``e:real``) THEN FULL_SIMP_TAC std_ss [] THEN
  ASM_CASES_TAC ``(x:real) IN interval[a,b]`` THENL
   [ALL_TAC,
    SUBGOAL_THEN
     ``?d. &0 < d /\ ball(x,d) SUBSET (univ(:real) DIFF interval[a,b])``
    STRIP_ASSUME_TAC THENL
     [ASM_MESON_TAC[closed_def, OPEN_CONTAINS_BALL, CLOSED_INTERVAL,
                    IN_DIFF, IN_UNIV], ALL_TAC] THEN
    DISJ2_TAC THEN MAP_EVERY EXISTS_TAC [``x:real``, ``min d e:real``] THEN
    ASM_REWRITE_TAC[REAL_LT_MIN, SUBSET_DEF] THEN
    POP_ASSUM MP_TAC THEN GEN_REWR_TAC LAND_CONV [SUBSET_DEF] THEN
    UNDISCH_TAC ``ball (x,e) SUBSET s INTER (interval [(a,b)] UNION BIGUNION f)`` THEN
    GEN_REWR_TAC LAND_CONV [SUBSET_DEF] THEN
    SIMP_TAC std_ss [IN_BALL, REAL_LT_MIN, IN_DIFF, IN_INTER, IN_UNIV, IN_UNION] THEN
    ASM_MESON_TAC[]] THEN
  ASM_CASES_TAC ``(x:real) IN interval(a,b)`` THENL
   [DISJ1_TAC THEN
    SUBGOAL_THEN
     ``?d. &0 < d /\ ball(x:real,d) SUBSET interval(a,b)``
    STRIP_ASSUME_TAC THENL
     [ASM_MESON_TAC[OPEN_CONTAINS_BALL, OPEN_INTERVAL], ALL_TAC] THEN
    MAP_EVERY EXISTS_TAC [``x:real``, ``min d e:real``] THEN
    ASM_REWRITE_TAC[REAL_LT_MIN, SUBSET_DEF] THEN
    POP_ASSUM MP_TAC THEN GEN_REWR_TAC LAND_CONV [SUBSET_DEF] THEN
    UNDISCH_TAC ``ball (x,e) SUBSET s INTER (interval [(a,b)] UNION BIGUNION f)`` THEN
    GEN_REWR_TAC LAND_CONV [SUBSET_DEF] THEN
    SIMP_TAC std_ss [IN_BALL, REAL_LT_MIN, IN_DIFF, IN_INTER, IN_UNIV, IN_UNION] THEN
    ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED, SUBSET_DEF],
    ALL_TAC] THEN
  POP_ASSUM MP_TAC THEN GEN_REWR_TAC (LAND_CONV o RAND_CONV) [IN_INTERVAL] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
  REWRITE_TAC[GSYM REAL_LT_LE, DE_MORGAN_THM] THEN
  STRIP_TAC THEN DISJ2_TAC THENL
   [EXISTS_TAC ``x + -e / &2:real``,
    EXISTS_TAC ``x + e / &2:real``] THEN
  EXISTS_TAC ``e / &2:real`` THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
   ``b1 SUBSET k INTER (i UNION s)
    ==> b2 SUBSET b1 /\ (b2 INTER i = {})
        ==> b2 SUBSET k INTER s``)) THEN
  (CONJ_TAC THENL
    [REWRITE_TAC[SUBSET_DEF, IN_BALL] THEN
     GEN_TAC THEN MATCH_MP_TAC lemma1 THEN REWRITE_TAC [lemma2, ABS_NEG, ABS_REFL] THEN
     UNDISCH_TAC ``&0 < e:real`` THEN ONCE_REWRITE_TAC [GSYM REAL_LT_HALF1] THEN
     ASM_SIMP_TAC std_ss [REAL_LE_LT],
     ALL_TAC]) THEN
  REWRITE_TAC[EXTENSION, IN_INTER, IN_INTERVAL, NOT_IN_EMPTY] THEN
  X_GEN_TAC ``y:real`` THEN REWRITE_TAC[IN_BALL, dist] THEN
  DISCH_TAC THEN FULL_SIMP_TAC std_ss [REAL_NOT_LT, lemma2] THEN
  POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC [AND_IMP_INTRO] THEN
  POP_ASSUM MP_TAC THEN UNDISCH_TAC ``0 < e:real`` THENL
  [KNOW_TAC ``a = x:real`` THENL [METIS_TAC [REAL_LE_ANTISYM], ALL_TAC],
   KNOW_TAC ``b = x:real`` THENL [METIS_TAC [REAL_LE_ANTISYM], ALL_TAC]] THEN
  DISC_RW_KILL THEN REAL_ARITH_TAC);

(* ------------------------------------------------------------------------- *)
(* This lemma about iterations comes up in a few places.                     *)
(* ------------------------------------------------------------------------- *)

val ITERATE_NONZERO_IMAGE_LEMMA = store_thm ("ITERATE_NONZERO_IMAGE_LEMMA",
 ``!op s f g a.
   monoidal op /\ FINITE s /\ (g(a) = neutral op) /\
   (!x y. x IN s /\ y IN s /\ (f x = f y) /\ ~(x = y) ==> (g(f x) = neutral op))
    ==> (iterate op {f x | x | x IN s /\ ~(f x = a)} g =
         iterate op s (g o f))``,
  REPEAT STRIP_TAC THEN
  GEN_REWR_TAC RAND_CONV [GSYM ITERATE_SUPPORT] THEN
  REWRITE_TAC [support] THEN
  ONCE_REWRITE_TAC[SET_RULE ``{f x |x| x IN s /\ ~(f x = a)} =
   IMAGE f {x | x IN s /\ ~(f x = a)}``] THEN
  KNOW_TAC ``(!x y.
       x IN {x | x IN s /\ ~((g o f) x = neutral op)} /\
       y IN {x | x IN s /\ ~((g o f) x = neutral op)} /\
       (f x = f y) ==> (x = y))
  ==> (iterate (op:'a->'a->'a) (IMAGE (f:'b->'c) {x | x IN s /\ ~((g o f) x = neutral op)}) g =
       iterate op {x | x IN s /\ ~((g o f) x = neutral op)} ((g:'c->'a) o f))`` THENL
  [SRW_TAC [][ITERATE_IMAGE], ALL_TAC] THEN
  KNOW_TAC ``(!x y.
    x IN {x | x IN s /\ ((g:'c->'a) o (f:'b->'c)) x <> neutral op} /\
    y IN {x | x IN s /\ (g o f) x <> neutral op} /\
    (f x = f y) ==> (x = y))`` THENL
  [SIMP_TAC std_ss [GSPECIFICATION, o_THM] THEN ASM_MESON_TAC[],
   DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
  DISCH_THEN(SUBST1_TAC o SYM) THEN
  KNOW_TAC ``IMAGE f {x | x IN s /\ ~(((g:'c->'a) o (f:'b->'c)) x = neutral op)} SUBSET
             IMAGE f {x | x IN s /\ ~(f x = a)} /\
   (!x. x IN IMAGE f {x | x IN s /\ ~(f x = a)} /\
      ~(x IN IMAGE f {x | x IN s /\ ~((g o f) x = neutral op)})
      ==> (g x = neutral (op:'a->'a->'a)))`` THENL
  [ALL_TAC, METIS_TAC [ITERATE_SUPERSET]] THEN
  ASM_SIMP_TAC std_ss [IMAGE_FINITE, FINITE_RESTRICT] THEN
  SIMP_TAC std_ss [IMP_CONJ, FORALL_IN_IMAGE, SUBSET_DEF] THEN
  SIMP_TAC std_ss [GSPECIFICATION, IN_IMAGE, o_THM] THEN
  ASM_MESON_TAC[]);

(* ------------------------------------------------------------------------- *)
(* Bounds on intervals where they exist.                                     *)
(* ------------------------------------------------------------------------- *)

(* NOTE: HOL Light's original definitions:

   `sup {a | ?x. x IN s /\ (x = a)}` = `sup s`
   `inf {a | ?x. x IN s /\ (x = a)}` = `inf s`

   are not specified on {} but `sup {} = inf {}` can be proven due to the
   definition of `inf` in HOL Light. However in HOL4 this is not derivable.
   Now we explicitly define that the upper and lower bounds of {} are both 0.
   This change shouldn't cause anything wrong. -- Chun Tian, Oct 24, 2019.
 *)
Definition interval_upperbound :
    (interval_upperbound:(real->bool)->real) s =
       if s = {} then 0:real else sup s
End

Definition interval_lowerbound :
    (interval_lowerbound:(real->bool)->real) s =
       if s = {} then 0:real else inf s
End

Theorem INTERVAL_UPPERBOUND :
    !a b:real. a <= b ==> (interval_upperbound(interval[a,b]) = b)
Proof
    RW_TAC std_ss [interval_upperbound]
 >- (fs [EXTENSION, GSPECIFICATION, IN_INTERVAL] \\
     METIS_TAC [REAL_LE_REFL])
 >> MATCH_MP_TAC REAL_SUP_UNIQUE
 >> SIMP_TAC std_ss [GSPECIFICATION, IN_INTERVAL]
 >> ASM_MESON_TAC[REAL_LE_REFL]
QED

Theorem OPEN_INTERVAL_UPPERBOUND :
    !a b:real. a < b ==> interval_upperbound(interval(a,b)) = b
Proof
    RW_TAC std_ss [interval_upperbound]
 >- METIS_TAC [INTERVAL_EQ_EMPTY, GSYM real_lte]
 >> MATCH_MP_TAC REAL_SUP_UNIQUE
 >> rw [GSPECIFICATION, IN_INTERVAL]
 >- (MATCH_MP_TAC REAL_LT_IMP_LE >> art [])
 >> MP_TAC (Q.SPECL [‘max a b'’, ‘b’] REAL_MEAN)
 >> rw [REAL_MAX_LT]
 >> Q.EXISTS_TAC ‘z’ >> art []
QED

Theorem INTERVAL_LOWERBOUND :
    !a b:real. a <= b ==> (interval_lowerbound(interval[a,b]) = a)
Proof
    RW_TAC std_ss [interval_lowerbound]
 >- (fs [EXTENSION, GSPECIFICATION, IN_INTERVAL] \\
     METIS_TAC [REAL_LE_REFL])
 >> MATCH_MP_TAC REAL_INF_UNIQUE
 >> SIMP_TAC std_ss [GSPECIFICATION, IN_INTERVAL]
 >> ASM_MESON_TAC [REAL_LE_REFL]
QED

Theorem OPEN_INTERVAL_LOWERBOUND :
    !a b:real. a < b ==> interval_lowerbound(interval(a,b)) = a
Proof
    RW_TAC std_ss [interval_lowerbound]
 >- METIS_TAC [INTERVAL_EQ_EMPTY, GSYM real_lte]
 >> MATCH_MP_TAC REAL_INF_UNIQUE
 >> rw [GSPECIFICATION, IN_INTERVAL]
 >- (MATCH_MP_TAC REAL_LT_IMP_LE >> art [])
 >> MP_TAC (Q.SPECL [‘a’, ‘min b b'’] REAL_MEAN)
 >> rw [REAL_LT_MIN]
 >> Q.EXISTS_TAC ‘z’ >> art []
QED

Theorem INTERVAL_LOWERBOUND_NONEMPTY :
    !a b:real. ~(interval[a,b] = {}) ==>
               (interval_lowerbound(interval[a,b]) = a)
Proof
    SIMP_TAC std_ss [INTERVAL_LOWERBOUND, INTERVAL_NE_EMPTY]
QED

Theorem INTERVAL_UPPERBOUND_NONEMPTY :
    !a b:real. ~(interval[a,b] = {}) ==>
               (interval_upperbound(interval[a,b]) = b)
Proof
    SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_NE_EMPTY]
QED

Theorem INTERVAL_BOUNDS_EMPTY :
    (interval_upperbound {} = 0) /\
    (interval_lowerbound {} = 0)
Proof
    rw [interval_upperbound, interval_lowerbound]
QED

(* ------------------------------------------------------------------------- *)
(* Content (length) of an interval.                                          *)
(* ------------------------------------------------------------------------- *)

val content = new_definition ("content",
  ``content(s:real->bool) =
    if s = {} then 0:real
              else (interval_upperbound s - interval_lowerbound s)``);

val CONTENT_CLOSED_INTERVAL = store_thm ("CONTENT_CLOSED_INTERVAL",
 ``!a b:real. a <= b ==> (content(interval[a,b]) = b - a)``,
 REPEAT GEN_TAC THEN DISCH_TAC THEN SIMP_TAC std_ss [interval] THEN
 KNOW_TAC ``{x | (a :real) <= x /\ x <= (b :real)} <> {}`` THENL
 [ONCE_REWRITE_TAC [GSYM MEMBER_NOT_EMPTY] THEN
  FULL_SIMP_TAC std_ss [GSPECIFICATION, REAL_LE_LT] THENL
  [KNOW_TAC ``(?(x :real). a < x /\ x < b)`` THENL
  [FULL_SIMP_TAC std_ss [REAL_MEAN], ALL_TAC] THEN STRIP_TAC THEN
  EXISTS_TAC ``x:real`` THEN ASM_REWRITE_TAC [],
  EXISTS_TAC ``a:real`` THEN ASM_REWRITE_TAC []],
  FULL_SIMP_TAC std_ss [content, INTERVAL_UPPERBOUND,
                                 INTERVAL_LOWERBOUND, GSYM interval]]);

val CONTENT_UNIT = store_thm ("CONTENT_UNIT",
 ``content(interval[0,1]) = 1:real``,
  SIMP_TAC arith_ss [CONTENT_CLOSED_INTERVAL, REAL_LE_01, REAL_SUB_RZERO]);

val CONTENT_POS_LE = store_thm ("CONTENT_POS_LE",
 ``!a b:real. &0 <= content(interval[a,b])``,
  REPEAT GEN_TAC THEN REWRITE_TAC[content] THEN
  COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN
  FULL_SIMP_TAC std_ss [INTERVAL_NE_EMPTY] THEN
  ASM_SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_LOWERBOUND, REAL_SUB_LE]);

val CONTENT_POS_LT = store_thm ("CONTENT_POS_LT",
 ``!a b:real. a < b ==> &0 < content(interval[a,b])``,
  REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC std_ss [CONTENT_CLOSED_INTERVAL, REAL_LT_IMP_LE] THEN
  ASM_SIMP_TAC std_ss [REAL_SUB_LT]);

val CONTENT_EQ_0_GEN = store_thm ("CONTENT_EQ_0_GEN",
 ``!s:real->bool. bounded s
     ==> ((content s = &0) <=> ?a. !x. x IN s ==> (x = a))``,
  REPEAT GEN_TAC THEN REWRITE_TAC[content] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
  REWRITE_TAC [bounded_def] THEN DISCH_TAC THEN
  ASM_SIMP_TAC std_ss [interval_upperbound, interval_lowerbound,
  GSPEC_ID, REAL_SUB_0, REAL_SUP_EQ_INF] THEN EQ_TAC THENL
  [METIS_TAC [GSYM UNIQUE_MEMBER_SING],
   REWRITE_TAC [GSYM UNIQUE_MEMBER_SING] THEN KNOW_TAC ``?a:real. a IN s`` THENL
   [EXISTS_TAC ``CHOICE (s:real->bool)`` THEN
    METIS_TAC [CHOICE_DEF, GSYM SPECIFICATION], METIS_TAC []]]);

val CONTENT_EQ_0 = store_thm ("CONTENT_EQ_0",
 ``!a b:real. (content(interval[a,b]) = &0) <=> b <= a``,
  REPEAT GEN_TAC THEN REWRITE_TAC[content, INTERVAL_EQ_EMPTY] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
  [FULL_SIMP_TAC std_ss [GSYM INTERVAL_EQ_EMPTY, REAL_LT_IMP_LE],
   FULL_SIMP_TAC std_ss [GSYM INTERVAL_EQ_EMPTY, REAL_NOT_LT,
   INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND, REAL_SUB_0] THEN
   METIS_TAC [REAL_LE_LT, REAL_LE_ANTISYM]]);

val CONTENT_0_SUBSET_GEN = store_thm ("CONTENT_0_SUBSET_GEN",
 ``!s t:real->bool.
      s SUBSET t /\ bounded t /\ (content t = &0) ==> (content s = &0)``,
  REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  SUBGOAL_THEN ``bounded(s:real->bool)`` ASSUME_TAC THENL
   [ASM_MESON_TAC[BOUNDED_SUBSET], ALL_TAC] THEN
  ASM_SIMP_TAC std_ss [CONTENT_EQ_0_GEN] THEN
  POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN SET_TAC[]);

val CONTENT_0_SUBSET = store_thm ("CONTENT_0_SUBSET",
 ``!s a b:real. s SUBSET interval[a,b] /\
        (content(interval[a,b]) = &0) ==> (content s = &0)``,
  MESON_TAC[CONTENT_0_SUBSET_GEN, BOUNDED_INTERVAL]);

val CONTENT_CLOSED_INTERVAL_CASES = store_thm ("CONTENT_CLOSED_INTERVAL_CASES",
 ``!a b:real. content(interval[a,b]) =
              if a <= b then b - a else &0``,
  REPEAT GEN_TAC THEN COND_CASES_TAC THEN
  ASM_SIMP_TAC std_ss [CONTENT_EQ_0, CONTENT_CLOSED_INTERVAL] THEN
  ASM_MESON_TAC[REAL_LE_TOTAL]);

val CONTENT_EQ_0_INTERIOR = store_thm ("CONTENT_EQ_0_INTERIOR",
 ``!a b:real.
        (content(interval[a,b]) = &0) <=> (interior(interval[a,b]) = {})``,
  REWRITE_TAC[CONTENT_EQ_0, INTERIOR_CLOSED_INTERVAL, INTERVAL_EQ_EMPTY]);

val CONTENT_EQ_0_1 = store_thm ("CONTENT_EQ_0_1",
 ``!a b:real.
        (content(interval[a,b]) = &0) <=> b <= a``,
  REWRITE_TAC [CONTENT_EQ_0]);

val CONTENT_POS_LT_EQ = store_thm ("CONTENT_POS_LT_EQ",
 ``!a b:real. &0 < content(interval[a,b]) <=> a < b``,
  REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CONTENT_POS_LT] THEN
  REWRITE_TAC[REAL_ARITH ``&0 < x:real <=> &0 <= x:real /\ ~(x = &0:real)``] THEN
  REWRITE_TAC[CONTENT_POS_LE, CONTENT_EQ_0] THEN MESON_TAC[REAL_NOT_LE]);

val CONTENT_EMPTY = store_thm ("CONTENT_EMPTY",
 ``content {} = &0``,
  REWRITE_TAC[content]);

val CONTENT_SUBSET = store_thm ("CONTENT_SUBSET",
 ``!a b c d:real.
        interval[a,b] SUBSET interval[c,d]
        ==> content(interval[a,b]) <= content(interval[c,d])``,
  REPEAT STRIP_TAC THEN GEN_REWR_TAC LAND_CONV [content] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[CONTENT_POS_LE] THEN
  UNDISCH_TAC ``interval [(a,b)] SUBSET interval [(c,d)]`` THEN
  REWRITE_TAC [SUBSET_DEF] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
  REWRITE_TAC[IN_INTERVAL] THEN DISCH_THEN(fn th =>
    MP_TAC(SPEC ``a:real`` th) THEN MP_TAC(SPEC ``b:real`` th)) THEN
  ASM_SIMP_TAC std_ss [REAL_LE_REFL, content] THEN REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[METIS [] ``(if b then c else d) = (if ~b then d else c)``] THEN
  REWRITE_TAC[INTERVAL_NE_EMPTY] THEN COND_CASES_TAC THENL
  [ALL_TAC, ASM_MESON_TAC[REAL_LE_TRANS]] THEN
  ASM_SIMP_TAC std_ss [INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND] THEN
  METIS_TAC [real_sub, REAL_LE_ADD2, REAL_LE_NEG]);

val CONTENT_LT_NZ = store_thm ("CONTENT_LT_NZ",
 ``!a b. &0 < content(interval[a,b]) <=> ~(content(interval[a,b]) = &0)``,
  REWRITE_TAC[CONTENT_POS_LT_EQ, CONTENT_EQ_0] THEN MESON_TAC[REAL_NOT_LE]);

Theorem INTERVAL_BOUNDS_NULL :
    !a b:real. (content(interval[a,b]) = &0)
        ==> (interval_upperbound(interval[a,b]) =
             interval_lowerbound(interval[a,b]))
Proof
    rpt GEN_TAC >> ASM_CASES_TAC ``interval[a:real,b] = {}``
 >| [ (* goal 1 (of 2) *)
      RW_TAC std_ss [interval_upperbound, interval_lowerbound,
                     GSYM INTERVAL_EQ_EMPTY, NOT_IN_EMPTY] \\
      fs [EXTENSION, GSPECIFICATION, NOT_IN_EMPTY, IN_INTERVAL] \\
      METIS_TAC [real_lte, REAL_LE_REFL],
      (* goal 2 (of 2) *)
      RULE_ASSUM_TAC (SIMP_RULE std_ss [GSYM INTERVAL_EQ_EMPTY, REAL_NOT_LT]) \\
      ASM_SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_LOWERBOUND] \\
      REWRITE_TAC [CONTENT_EQ_0] >> ASM_REAL_ARITH_TAC ]
QED

val INTERVAL_BOUNDS_EMPTY = store_thm ("INTERVAL_BOUNDS_EMPTY",
 ``interval_upperbound({}:real->bool) =
   interval_lowerbound({}:real->bool)``,
  METIS_TAC [INTERVAL_BOUNDS_NULL, CONTENT_EMPTY, EMPTY_AS_INTERVAL]);

(* ------------------------------------------------------------------------- *)
(* The notion of a gauge --- simply an open set containing the point.        *)
(* ------------------------------------------------------------------------- *)

(* `gauge :(real -> (real set)) -> bool` *)
val gauge_def = new_definition ("gauge_def",
  ``gauge_def d <=> !x. x IN d(x) /\ open(d(x))``);

(* `gauge :(real set -> (real -> real) -> bool)` was defined in transcTheory *)
val _ = overload_on ("gauge", ``gauge_def``);

val GAUGE_BALL_DEPENDENT = store_thm ("GAUGE_BALL_DEPENDENT",
 ``!e. (!x. &0 < e(x)) ==> gauge(\x. ball(x,e(x)))``,
  SIMP_TAC std_ss [gauge_def, OPEN_BALL, IN_BALL, DIST_REFL]);

val GAUGE_BALL = store_thm ("GAUGE_BALL",
 ``!e. &0 < e ==> gauge (\x. ball(x,e))``,
  SIMP_TAC std_ss [gauge_def, OPEN_BALL, IN_BALL, DIST_REFL]);

val GAUGE_TRIVIAL = store_thm ("GAUGE_TRIVIAL",
 ``gauge (\x. ball(x,&1))``,
  SIMP_TAC std_ss [GAUGE_BALL, REAL_LT_01]);

val GAUGE_INTER = store_thm ("GAUGE_INTER",
 ``!d1 d2. gauge d1 /\ gauge d2 ==> gauge (\x. (d1 x) INTER (d2 x))``,
  SIMP_TAC std_ss [gauge_def, IN_INTER, OPEN_INTER]);

Theorem GAUGE_BIGINTER :
    !f s. FINITE s /\ (!d. d IN s ==> gauge (f d)) ==>
          gauge (\x. BIGINTER {f d x | d IN s})
Proof
    SIMP_TAC std_ss [gauge_def, IN_BIGINTER]
 >> REWRITE_TAC[SET_RULE ``{f d x | d IN s} = IMAGE (\d. f d x) s``]
 >> SIMP_TAC std_ss [FORALL_IN_IMAGE, OPEN_BIGINTER, IMAGE_FINITE]
QED

Theorem GAUGE_EXISTENCE_LEMMA :
    !p q. (!x:real. ?d:real. p x ==> &0 < d /\ q d x) <=>
          (!x:real. ?d:real. &0 < d /\ (p x ==> q d x))
Proof
    MESON_TAC [REAL_LT_01]
QED

(* ------------------------------------------------------------------------- *)
(* Divisions.                                                                *)
(* ------------------------------------------------------------------------- *)

val _ = set_fixity "division_of" (Infix(NONASSOC, 450));

val division_of = new_definition ("division_of",
 ``s division_of i <=>
        FINITE s /\
        (!k. k IN s
             ==> k SUBSET i /\ ~(k = {}) /\ ?a b. k = interval[a,b]) /\
        (!k1 k2. k1 IN s /\ k2 IN s /\ ~(k1 = k2)
                 ==> (interior(k1) INTER interior(k2) = {})) /\
        (BIGUNION s = i)``);

Theorem DIVISION_OF :
    !s i. s division_of i <=>
        FINITE s /\
        (!k. k IN s ==> ~(k = {}) /\ ?a b. k = interval[a,b]) /\
        (!k1 k2. k1 IN s /\ k2 IN s /\ ~(k1 = k2)
                 ==> (interior(k1) INTER interior(k2) = {})) /\
        (BIGUNION s = i)
Proof
    NTAC 2 GEN_TAC
 >> REWRITE_TAC [division_of] >> SET_TAC []
QED

val DIVISION_OF_FINITE = store_thm ("DIVISION_OF_FINITE",
 ``!s i. s division_of i ==> FINITE s``,
  MESON_TAC[division_of]);

val DIVISION_OF_SELF = store_thm ("DIVISION_OF_SELF",
 ``!a b. ~(interval[a,b] = {}) ==> {interval[a,b]} division_of interval[a,b]``,
  REWRITE_TAC[division_of, FINITE_INSERT, FINITE_EMPTY, IN_SING, BIGUNION_SING] THEN
  MESON_TAC[SUBSET_REFL]);

val DIVISION_OF_TRIVIAL = store_thm ("DIVISION_OF_TRIVIAL",
 ``!s. s division_of {} <=> (s = {})``,
  REWRITE_TAC[division_of, SUBSET_EMPTY, CONJ_ASSOC] THEN
  REWRITE_TAC[TAUT `~(p /\ ~p)`] THEN REWRITE_TAC [GSYM CONJ_ASSOC] THEN
  REWRITE_TAC [METIS [GSYM NOT_EXISTS_THM, MEMBER_NOT_EMPTY]
                      ``(!k. k NOTIN s) = (s = {})``] THEN
  METIS_TAC[FINITE_EMPTY, FINITE_INSERT, BIGUNION_EMPTY, NOT_IN_EMPTY]);

val EMPTY_DIVISION_OF = store_thm ("EMPTY_DIVISION_OF",
 ``!s. {} division_of s <=> (s = {})``,
  REWRITE_TAC[division_of, BIGUNION_EMPTY, FINITE_EMPTY, NOT_IN_EMPTY] THEN
  MESON_TAC[]);

val lemma = Q.prove (
   `s SUBSET {{a}} /\ p /\ (BIGUNION s = {a}) <=> (s = {{a}}) /\ p`,
    EQ_TAC THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[SET_RULE ``BIGUNION {a} = a``] THEN
    REPEAT (POP_ASSUM MP_TAC) THEN SET_TAC[]);

val DIVISION_OF_SING = store_thm ("DIVISION_OF_SING",
 ``!s a. s division_of interval[a,a] <=> (s = {interval[a,a]})``,
  REWRITE_TAC[division_of, INTERVAL_SING] THEN
  REWRITE_TAC[SET_RULE ``k SUBSET {a} /\ ~(k = {}) /\ p <=> (k = {a}) /\ p``] THEN
  REWRITE_TAC[GSYM INTERVAL_SING] THEN
  REWRITE_TAC[MESON[] ``((k = interval[a,b]) /\ ?c d. (k = interval[c,d])) <=>
                        ((k = interval[a,b]))``] THEN
  REWRITE_TAC[SET_RULE ``(!k. k IN s ==> (k = a)) <=> s SUBSET {a}``] THEN
  REWRITE_TAC[INTERVAL_SING, lemma] THEN MESON_TAC[FINITE_EMPTY, FINITE_INSERT, IN_SING]);

val ELEMENTARY_EMPTY = store_thm ("ELEMENTARY_EMPTY",
 ``?p. p division_of {}``,
  REWRITE_TAC[DIVISION_OF_TRIVIAL, EXISTS_REFL]);

val ELEMENTARY_INTERVAL = store_thm ("ELEMENTARY_INTERVAL",
 ``!a b. ?p. p division_of interval[a,b]``,
  MESON_TAC[DIVISION_OF_TRIVIAL, DIVISION_OF_SELF]);

val DIVISION_CONTAINS = store_thm ("DIVISION_CONTAINS",
 ``!s i. s division_of i ==> !x. x IN i ==> ?k. x IN k /\ k IN s``,
  REWRITE_TAC[division_of, EXTENSION, IN_BIGUNION] THEN MESON_TAC[]);

val FORALL_IN_DIVISION = store_thm ("FORALL_IN_DIVISION",
 ``!P d i. d division_of i
           ==> ((!x. x IN d ==> P x) <=>
               (!a b. interval[a,b] IN d ==> P(interval[a,b])))``,
  REWRITE_TAC[division_of] THEN MESON_TAC[]);

val FORALL_IN_DIVISION_NONEMPTY = store_thm ("FORALL_IN_DIVISION_NONEMPTY",
 ``!P d i.
         d division_of i
         ==> ((!x. x IN d ==> P x) <=>
              (!a b. interval [a,b] IN d /\ ~(interval[a,b] = {})
                     ==> P (interval [a,b])))``,
  REWRITE_TAC[division_of] THEN MESON_TAC[]);

val DIVISION_OF_SUBSET = store_thm ("DIVISION_OF_SUBSET",
 ``!p q:(real->bool)->bool.
        p division_of (BIGUNION p) /\ q SUBSET p ==> q division_of (BIGUNION q)``,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  REWRITE_TAC[division_of] THEN
  REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL
   [ASM_MESON_TAC[SUBSET_FINITE], POP_ASSUM MP_TAC THEN SET_TAC[],
    POP_ASSUM MP_TAC THEN SET_TAC[]]);

val DIVISION_OF_UNION_SELF = store_thm ("DIVISION_OF_UNION_SELF",
 ``!p s. p division_of s ==> p division_of (BIGUNION p)``,
  REWRITE_TAC[division_of] THEN MESON_TAC[]);

val DIVISION_OF_CONTENT_0 = store_thm ("DIVISION_OF_CONTENT_0",
 ``!a b d. (content(interval[a,b]) = &0) /\ d division_of interval[a,b]
           ==> !k. k IN d ==> (content k = &0)``,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  KNOW_TAC ``!k. (content k = 0) = (\k. content k = 0) k`` THENL
  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
  FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN
  BETA_TAC THEN
  REWRITE_TAC[GSYM REAL_LE_ANTISYM, CONTENT_POS_LE] THEN
  METIS_TAC[CONTENT_SUBSET, division_of]);

val lemma = Q.prove (
   `{k1 INTER k2 | k1 IN p1 /\ k2 IN p2 /\ ~(k1 INTER k2 = {})} =
        {s | s IN IMAGE (\(k1,k2). k1 INTER k2) (p1 CROSS p2) /\
             ~(s = {})}`,
    REWRITE_TAC[EXTENSION] THEN
    SIMP_TAC std_ss [IN_IMAGE, GSPECIFICATION, EXISTS_PROD, IN_CROSS] THEN
    MESON_TAC[]);

val DIVISION_INTER = store_thm ("DIVISION_INTER",
 ``!s1 s2:real->bool p1 p2.
        p1 division_of s1 /\
        p2 division_of s2
        ==> {k1 INTER k2 | k1 IN p1 /\ k2 IN p2 /\ ~(k1 INTER k2 = {})}
            division_of (s1 INTER s2)``,
  REPEAT GEN_TAC THEN REWRITE_TAC[DIVISION_OF] THEN STRIP_TAC THEN
  ASM_SIMP_TAC std_ss [lemma, FINITE_RESTRICT, FINITE_CROSS, IMAGE_FINITE] THEN
  SIMP_TAC std_ss [GSPECIFICATION] THEN
  SIMP_TAC std_ss [GSYM AND_IMP_INTRO, FORALL_IN_IMAGE, RIGHT_FORALL_IMP_THM] THEN
  SIMP_TAC std_ss [FORALL_PROD, IN_CROSS] THEN REPEAT CONJ_TAC THENL
   [ASM_MESON_TAC[INTER_INTERVAL],
    REPEAT STRIP_TAC THEN
    MATCH_MP_TAC(SET_RULE
    ``((interior x1 INTER interior x2 = {}) \/
       (interior y1 INTER interior y2 = {})) /\
      interior(x1 INTER y1) SUBSET interior(x1) /\
      interior(x1 INTER y1) SUBSET interior(y1) /\
      interior(x2 INTER y2) SUBSET interior(x2) /\
      interior(x2 INTER y2) SUBSET interior(y2)
      ==> (interior(x1 INTER y1) INTER interior(x2 INTER y2) = {})``) THEN
    CONJ_TAC THENL [ASM_MESON_TAC[], ALL_TAC] THEN
    REPEAT CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[],
    REWRITE_TAC[SET_RULE ``BIGUNION {x | x IN s /\ ~(x = {})} = BIGUNION s``] THEN
    REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM)) THEN
    GEN_REWR_TAC I [EXTENSION] THEN
    SIMP_TAC std_ss [IN_BIGUNION, IN_IMAGE, EXISTS_PROD, IN_CROSS, IN_INTER] THEN
    MESON_TAC[IN_INTER]]);

val DIVISION_INTER_1 = store_thm ("DIVISION_INTER_1",
 ``!d i a b:real.
        d division_of i /\ interval[a,b] SUBSET i
        ==> { interval[a,b] INTER k | k |
                 k IN d /\ ~(interval[a,b] INTER k = {}) }
            division_of interval[a,b]``,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC ``interval[a:real,b] = {}`` THEN
  ASM_SIMP_TAC std_ss [INTER_EMPTY, DIVISION_OF_TRIVIAL] THENL
  [SET_TAC [],
  MP_TAC(ISPECL [``interval[a:real,b]``, ``i:real->bool``,
                 ``{interval[a:real,b]}``, ``d:(real->bool)->bool``]
                DIVISION_INTER) THEN
  ASM_SIMP_TAC std_ss [DIVISION_OF_SELF, SET_RULE ``s SUBSET t ==> (s INTER t = s)``] THEN
  MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN AP_TERM_TAC THEN
  SIMP_TAC std_ss [EXTENSION, EXISTS_PROD, GSPECIFICATION] THEN SET_TAC[]]);

val ELEMENTARY_INTER = store_thm ("ELEMENTARY_INTER",
 ``!s t. (?p. p division_of s) /\ (?p. p division_of t)
         ==> ?p. p division_of (s INTER t)``,
  METIS_TAC[DIVISION_INTER]);

val ELEMENTARY_BIGINTER = store_thm ("ELEMENTARY_BIGINTER",
 ``!f:(real->bool)->bool.
        FINITE f /\ ~(f = {}) /\
        (!s. s IN f ==> ?p. p division_of s)
        ==> ?p. p division_of (BIGINTER f)``,
  REWRITE_TAC[GSYM AND_IMP_INTRO] THEN GEN_TAC THEN
  KNOW_TAC ``(f <> {} ==>
             (!s. s IN f ==> ?p. p division_of s) ==>
             ?p. p division_of BIGINTER f) =
             (\f:(real->bool)->bool. (f <> {}) ==>
             (!s. s IN f ==> ?p. p division_of s) ==>
             ?p. p division_of BIGINTER f) f`` THENL
  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
  REWRITE_TAC[BIGINTER_INSERT] THEN SIMP_TAC std_ss [GSYM RIGHT_FORALL_IMP_THM] THEN
  MAP_EVERY X_GEN_TAC [``s:(real->bool)->bool``, ``s:real->bool``] THEN
  ASM_CASES_TAC ``s:(real->bool)->bool = {}`` THEN ASM_REWRITE_TAC[] THENL
   [REWRITE_TAC[BIGINTER_EMPTY, INTER_UNIV, IN_SING] THEN MESON_TAC[],
    REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN
    MATCH_MP_TAC ELEMENTARY_INTER THEN ASM_MESON_TAC[]]);

val DIVISION_DISJOINT_UNION = store_thm ("DIVISION_DISJOINT_UNION",
 ``!s1 s2:real->bool p1 p2.
    p1 division_of s1 /\ p2 division_of s2 /\
    (interior s1 INTER interior s2 = {})
    ==> (p1 UNION p2) division_of (s1 UNION s2)``,
  REPEAT GEN_TAC THEN REWRITE_TAC[division_of] THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[FINITE_UNION, IN_UNION, EXISTS_OR_THM, SET_RULE
   ``BIGUNION {x | P x \/ Q x} = BIGUNION {x | P x} UNION BIGUNION {x | Q x}``] THEN
  CONJ_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN
  CONJ_TAC THENL [ALL_TAC, ASM_SET_TAC[]] THEN
  REPEAT STRIP_TAC THENL
  [ASM_SET_TAC[], ALL_TAC, ALL_TAC, ASM_SET_TAC[]] THEN
  MATCH_MP_TAC(SET_RULE ``!s' t'. s SUBSET s' /\ t SUBSET t' /\
   (s' INTER t' = {}) ==> (s INTER t = {})``)
  THENL
  [MAP_EVERY EXISTS_TAC
   [``interior s1:real->bool``, ``interior s2:real->bool``],
   MAP_EVERY EXISTS_TAC
   [``interior s2:real->bool``, ``interior s1:real->bool``]] THEN
  REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC SUBSET_INTERIOR) THEN
  ASM_SET_TAC[]);

val PARTIAL_DIVISION_EXTEND_1 = store_thm ("PARTIAL_DIVISION_EXTEND_1",
 ``!a b c d:real.
   interval[c,d] SUBSET interval[a,b] /\ ~(interval[c,d] = {})
   ==> ?p. p division_of interval[a,b] /\ interval[c,d] IN p``,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC ``interval[a:real,b] = {}`` THENL
  [ASM_SET_TAC[], ALL_TAC] THEN
  POP_ASSUM (MP_TAC o REWRITE_RULE [INTERVAL_NE_EMPTY]) THEN
  POP_ASSUM (MP_TAC o REWRITE_RULE [INTERVAL_NE_EMPTY]) THEN
  REPEAT STRIP_TAC THEN
  EXISTS_TAC
   ``{interval
    [(@f. f = if 1:num < l then (c:real) else (a:real)):real,
     (@f. f = if 1:num < l then d else if 1:num = l then c else b)] |
      l IN 1:num..(1+1:num)} UNION
     {interval
    [(@f. f = if 1:num < l then c else if 1:num = l then d else a),
     (@f. f = if 1:num < l then (d:real) else (b:real)):real] |
      l IN 1:num..(1+1:num)}`` THEN
  MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
  [REWRITE_TAC[IN_UNION] THEN DISJ1_TAC THEN
   SIMP_TAC std_ss [GSPECIFICATION] THEN EXISTS_TAC ``1+1:num`` THEN
  SIMP_TAC std_ss [IN_NUMSEG, LESS_EQ_REFL, ARITH_PROVE ``1 <= n + 1:num``],
  DISCH_TAC] THEN
  UNDISCH_TAC ``interval [(c,d)] SUBSET interval [(a,b)]`` THEN
  GEN_REWR_TAC LAND_CONV [SUBSET_INTERVAL] THEN
  ASM_REWRITE_TAC[DIVISION_OF] THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL
  [SIMP_TAC std_ss [GSYM IMAGE_DEF] THEN
   SIMP_TAC std_ss [FINITE_UNION, IMAGE_FINITE, FINITE_NUMSEG],
   REWRITE_TAC[IN_UNION, TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
   SIMP_TAC std_ss [GSYM IMAGE_DEF, FORALL_AND_THM, FORALL_IN_IMAGE] THEN
   ASM_SIMP_TAC std_ss [IN_NUMSEG, INTERVAL_NE_EMPTY] THEN
   CONJ_TAC THEN X_GEN_TAC ``l:num`` THEN DISCH_TAC THEN
  (CONJ_TAC THENL [ALL_TAC, MESON_TAC[]]) THEN
   REPEAT STRIP_TAC THEN
   REPEAT (COND_CASES_TAC THEN ASM_SIMP_TAC std_ss []),
  SIMP_TAC std_ss [IN_UNION, IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
  SIMP_TAC std_ss [SET_RULE
   ``(!y. y IN {f x | x IN s} \/ y IN {g x | x IN s} ==> P y) <=>
     (!x. x IN s ==> P(f x) /\ P(g x))``] THEN
  SIMP_TAC std_ss [GSYM FORALL_AND_THM, IN_NUMSEG] THEN
  REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN
  SIMP_TAC std_ss [GSYM RIGHT_FORALL_IMP_THM] THEN
  KNOW_TAC ``!l l'. (\l l'.
  1:num <= l /\ l <= 2:num ==>
  1:num <= l' /\ l' <= 2:num ==>
  ((interval
      [(if 1 < l then c else a,
        if 1 < l then d else if 1 = l then c else b)] <>
    interval
      [(if 1 < l' then c else a,
        if 1 < l' then d else if 1 = l' then c else b)] ==>
    (interior
       (interval
          [(if 1 < l then c else a,
            if 1 < l then d else if 1 = l then c else b)]) INTER
     interior
       (interval
          [(if 1 < l' then c else a,
            if 1 < l' then d else if 1 = l' then c else b)]) =
     {})) /\
   (interval
      [(if 1 < l then c else a,
        if 1 < l then d else if 1 = l then c else b)] <>
    interval
      [(if 1 < l' then c else if 1 = l' then d else a,
        if 1 < l' then d else b)] ==>
    (interior
       (interval
          [(if 1 < l then c else a,
            if 1 < l then d else if 1 = l then c else b)]) INTER
     interior
       (interval
          [(if 1 < l' then c else if 1 = l' then d else a,
            if 1 < l' then d else b)]) =
     {}))) /\
  (interval
     [(if 1 < l then c else if 1 = l then d else a,
       if 1 < l then d else b)] <>
   interval
     [(if 1 < l' then c else a,
       if 1 < l' then d else if 1 = l' then c else b)] ==>
   (interior
      (interval
         [(if 1 < l then c else if 1 = l then d else a,
           if 1 < l then d else b)]) INTER
    interior
      (interval
         [(if 1 < l' then c else a,
           if 1 < l' then d else if 1 = l' then c else b)]) =
    {})) /\
  (interval
     [(if 1 < l then c else if 1 = l then d else a,
       if 1 < l then d else b)] <>
   interval
     [(if 1 < l' then c else if 1 = l' then d else a,
       if 1 < l' then d else b)] ==>
   (interior
      (interval
         [(if 1 < l then c else if 1 = l then d else a,
           if 1 < l then d else b)]) INTER
    interior
      (interval
         [(if 1 < l' then c else if 1 = l' then d else a,
           if 1 < l' then d else b)]) =
    {}))) l l'`` THENL
  [ALL_TAC, SIMP_TAC std_ss []] THEN
  MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL
  [SIMP_TAC std_ss [] THEN REPEAT GEN_TAC THEN
  ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b ==> a ==> c`] THEN
  SIMP_TAC std_ss [INTER_ACI, CONJ_ACI] THEN MESON_TAC[],
  ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [``l:num``, ``m:num``] THEN
  SIMP_TAC std_ss [] THEN
  DISCH_TAC THEN STRIP_TAC THEN STRIP_TAC THEN
  ONCE_REWRITE_TAC[TAUT `(~p ==> q) <=> (~q ==> p)`, METIS [] ``(a <> b) = ~(a = b:real)``] THEN
  REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN
  REWRITE_TAC[SET_RULE ``(s INTER t = {}) <=> !x. ~(x IN s /\ x IN t)``,
            METIS [] ``(a <> b) = ~(a = b:real)``] THEN
  ASM_SIMP_TAC std_ss [IN_NUMSEG, INTERVAL_NE_EMPTY, IN_INTERVAL,
   INTERIOR_CLOSED_INTERVAL] THEN
  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN
  REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN
  SIMP_TAC std_ss [NOT_FORALL_THM] THEN REPEAT CONJ_TAC THEN
  DISCH_THEN(X_CHOOSE_TAC ``x:real``) THEN
  AP_TERM_TAC THEN SIMP_TAC std_ss [CONS_11, PAIR_EQ] THENL
  [UNDISCH_TAC ``l:num <= m`` THEN GEN_REWR_TAC LAND_CONV [LESS_OR_EQ] THEN
   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
   UNDISCH_TAC ``((if 1:num < l then c else a) < x:real /\
          x:real < if 1:num < l then d else if 1 = l then c else b) /\
                  (if 1:num < m then c else a) < x:real /\
          x:real < if 1:num < m then d else if 1 = m then c else b`` THEN
   ASM_SIMP_TAC arith_ss [] THEN METIS_TAC [REAL_LT_ANTISYM],
   UNDISCH_TAC ``l:num <= m`` THEN GEN_REWR_TAC LAND_CONV [LESS_OR_EQ] THEN
   STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
   [UNDISCH_TAC ``((if 1:num < l then c else a) < x:real /\
           x:real < if 1:num < l then d else if 1 = l then c else b) /\
                   (if 1:num < m then c else if 1 = m then d else a) < x:real /\
           x:real < if 1:num < m then d else b`` THEN
   ASM_SIMP_TAC arith_ss [] THEN METIS_TAC [REAL_LT_ANTISYM], ALL_TAC] THEN
   FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
   CONJ_TAC THEN ASM_CASES_TAC ``1:num = l`` THEN
   ASM_SIMP_TAC arith_ss [LESS_REFL] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN
   UNDISCH_TAC `` ((if l:num < l then c else a) < x:real /\
           x:real < if l:num < l then d else if l = l then c else b) /\
                   (if l:num < l then c else if l = l then d else a) < x:real /\
           x:real < if l:num < l then d else b`` THEN
   ASM_SIMP_TAC arith_ss [LESS_REFL] THEN
   ASM_REAL_ARITH_TAC,
   UNDISCH_TAC ``l:num <= m`` THEN GEN_REWR_TAC LAND_CONV [LESS_OR_EQ] THEN
   STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
   [UNDISCH_TAC `` ((if 1:num < l then c else if 1 = l then d else a) < x:real /\
            x:real < if 1:num < l then d else b) /\
                    (if 1:num < m then c else a) < x:real /\
            x:real < if 1:num < m then d else if 1 = m then c else b`` THEN
   ASM_SIMP_TAC arith_ss [] THEN METIS_TAC [REAL_LT_ANTISYM], ALL_TAC] THEN
   FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
   CONJ_TAC THEN ASM_CASES_TAC ``1:num = l`` THEN
   ASM_SIMP_TAC arith_ss [LESS_REFL] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN
   UNDISCH_TAC ``((if l:num < l then c else if l = l then d else a) < x:real /\
          x:real < if l:num < l then d else b) /\
                  (if l:num < l then c else a) < x:real /\
          x:real < if l:num < l then d else if l = l then c else b`` THEN
   ASM_SIMP_TAC arith_ss [LESS_REFL] THEN
   ASM_REAL_ARITH_TAC,
   UNDISCH_TAC ``l:num <= m`` THEN GEN_REWR_TAC LAND_CONV [LESS_OR_EQ] THEN
   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
   UNDISCH_TAC ``((if 1:num < l then c else if 1 = l then d else a) < x:real /\
          x:real < if 1:num < l then d else b) /\
                  (if 1:num < m then c else if 1 = m then d else a) < x:real /\
          x:real < if 1:num < m then d else b`` THEN
   ASM_SIMP_TAC arith_ss [] THEN METIS_TAC [REAL_LT_ANTISYM]],
  MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
  [SIMP_TAC std_ss [IMP_CONJ, SUBSET_DEF, FORALL_IN_BIGUNION, GSYM IMAGE_DEF] THEN
   SIMP_TAC std_ss [IN_BIGUNION, IN_INSERT, IN_UNION, FORALL_IN_IMAGE,
    RIGHT_FORALL_IMP_THM, FORALL_AND_THM,
    TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN
   ASM_SIMP_TAC std_ss [IN_INTERVAL, IN_NUMSEG] THEN
   REPEAT CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
   METIS_TAC[REAL_LE_TRANS], ALL_TAC] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
   ``a IN s ==> (c DIFF a) SUBSET BIGUNION s ==> c SUBSET BIGUNION s``)) THEN
  REWRITE_TAC[SUBSET_DEF, IN_DIFF, IN_INTERVAL] THEN X_GEN_TAC ``x:real`` THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP] THEN
  REWRITE_TAC [GSYM DE_MORGAN_THM] THEN DISCH_TAC THEN
  SIMP_TAC std_ss [IN_BIGUNION] THEN ONCE_REWRITE_TAC [CONJ_SYM] THEN
  SIMP_TAC std_ss [IN_BIGUNION, GSYM IMAGE_DEF, EXISTS_IN_IMAGE, IN_UNION,
  EXISTS_OR_THM, RIGHT_AND_OVER_OR] THEN
  SIMP_TAC std_ss [OR_EXISTS_THM] THEN EXISTS_TAC ``1:num`` THEN
  ASM_SIMP_TAC std_ss [IN_NUMSEG, IN_INTERVAL,
   ARITH_PROVE ``x <= n ==> x <= n + 1:num``] THEN
  POP_ASSUM (MP_TAC o REWRITE_RULE [DE_MORGAN_THM]) THEN
  MATCH_MP_TAC MONO_OR THEN REWRITE_TAC[REAL_NOT_LE] THEN
  METIS_TAC [REAL_LE_LT]]);

val PARTIAL_DIVISION_EXTEND_INTERVAL = store_thm ("PARTIAL_DIVISION_EXTEND_INTERVAL",
 ``!p a b:real.
    p division_of (BIGUNION p) /\ (BIGUNION p) SUBSET interval[a,b]
    ==> ?q. p SUBSET q /\ q division_of interval[a,b]``,
  REPEAT GEN_TAC THEN ASM_CASES_TAC ``p:(real->bool)->bool = {}`` THEN
  ASM_REWRITE_TAC[EMPTY_SUBSET] THENL
  [MESON_TAC[ELEMENTARY_INTERVAL], STRIP_TAC] THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
  SUBGOAL_THEN ``!k:real->bool. k IN p ==> ?q. q division_of interval[a,b] /\
   k IN q`` MP_TAC THENL
  [X_GEN_TAC ``k:real->bool`` THEN DISCH_TAC THEN
   UNDISCH_TAC ``p division_of BIGUNION p`` THEN DISCH_TAC THEN
   FIRST_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
   ASM_REWRITE_TAC [] THEN STRIP_TAC THEN
   UNDISCH_TAC ``(!k. k IN p ==>
    k SUBSET BIGUNION p /\ k <> {} /\ ?a b. k = interval [(a,b)])`` THEN
   DISCH_THEN (MP_TAC o SPEC ``k:real->bool``) THEN
   ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN
   MATCH_MP_TAC PARTIAL_DIVISION_EXTEND_1 THEN ASM_SET_TAC[],
   ALL_TAC] THEN
  KNOW_TAC ``(!(k :real -> bool). ?(q :(real -> bool) -> bool).
   k IN (p :(real -> bool) -> bool) ==>
    q division_of interval [((a :real),(b :real))] /\ k IN q) ==>
   ?(q :(real -> bool) -> bool).
    p SUBSET q /\ q division_of interval [(a,b)]`` THENL
  [ALL_TAC, METIS_TAC [GSYM RIGHT_EXISTS_IMP_THM]] THEN
  SIMP_TAC std_ss [SKOLEM_THM] THEN
  DISCH_THEN(X_CHOOSE_TAC ``q:(real->bool)->(real->bool)->bool``) THEN
  SUBGOAL_THEN
   ``?d. d division_of BIGINTER {BIGUNION (q i DELETE i) | (i:real->bool) IN p}``
    MP_TAC THENL
  [MATCH_MP_TAC ELEMENTARY_BIGINTER THEN SIMP_TAC std_ss [GSYM IMAGE_DEF] THEN
   ASM_SIMP_TAC std_ss [IMAGE_EQ_EMPTY, IMAGE_FINITE] THEN
   SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN X_GEN_TAC ``k:real->bool`` THEN
   DISCH_TAC THEN EXISTS_TAC ``(q k) DELETE (k:real->bool)`` THEN
   MATCH_MP_TAC DIVISION_OF_SUBSET THEN
   EXISTS_TAC ``(q:(real->bool)->(real->bool)->bool) k`` THEN
   REWRITE_TAC[DELETE_SUBSET] THEN ASM_MESON_TAC[division_of],
   ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_TAC ``d:(real->bool)->bool``) THEN
  EXISTS_TAC ``(d UNION p):(real->bool)->bool`` THEN
  REWRITE_TAC[SUBSET_UNION] THEN
  SUBGOAL_THEN ``interval[a:real,b] =
   BIGINTER {BIGUNION (q i DELETE i) | i IN p} UNION
   BIGUNION p`` SUBST1_TAC THENL
  [SIMP_TAC std_ss [GSYM IMAGE_DEF] THEN MATCH_MP_TAC(SET_RULE
   ``~(s = {}) /\ (!i. i IN s ==> (f i UNION i = t))
    ==> (t = BIGINTER (IMAGE f s) UNION (BIGUNION s))``) THEN
  ASM_REWRITE_TAC[] THEN X_GEN_TAC ``k:real->bool`` THEN DISCH_TAC THEN
  BETA_TAC THEN MATCH_MP_TAC(SET_RULE
   ``(BIGUNION k = s) /\ i IN k ==> (BIGUNION (k DELETE i) UNION i = s)``) THEN
  ASM_MESON_TAC[division_of], ALL_TAC] THEN
  MATCH_MP_TAC DIVISION_DISJOINT_UNION THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC INTER_INTERIOR_BIGUNION_INTERVALS THEN
  ASM_REWRITE_TAC[OPEN_INTERIOR] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[division_of], ALL_TAC] THEN
  X_GEN_TAC ``k:real->bool`` THEN DISCH_TAC THEN
  MATCH_MP_TAC(SET_RULE
   ``!s. u SUBSET s /\ (s INTER t = {}) ==> (u INTER t = {})``) THEN
  EXISTS_TAC ``interior(BIGUNION(q k DELETE (k:real->bool)))`` THEN
  CONJ_TAC THENL
  [MATCH_MP_TAC SUBSET_INTERIOR THEN
   MATCH_MP_TAC(SET_RULE ``x IN s ==> BIGINTER s SUBSET x``) THEN ASM_SET_TAC[],
   ALL_TAC] THEN
  ONCE_REWRITE_TAC[INTER_COMM] THEN
  MATCH_MP_TAC INTER_INTERIOR_BIGUNION_INTERVALS THEN
  REWRITE_TAC[OPEN_INTERIOR, FINITE_DELETE, IN_DELETE] THEN
  ASM_MESON_TAC[division_of]);

val ELEMENTARY_BOUNDED = store_thm ("ELEMENTARY_BOUNDED",
 ``!s. (?p. p division_of s) ==> bounded s``,
  REWRITE_TAC[division_of] THEN
  METIS_TAC[BOUNDED_BIGUNION, BOUNDED_INTERVAL]);

val ELEMENTARY_SUBSET_INTERVAL = store_thm ("ELEMENTARY_SUBSET_INTERVAL",
 ``!s. (?p. p division_of s) ==> ?a b. s SUBSET interval[a,b]``,
  MESON_TAC[ELEMENTARY_BOUNDED, BOUNDED_SUBSET_CLOSED_INTERVAL]);

val DIVISION_UNION_INTERVALS_EXISTS = store_thm ("DIVISION_UNION_INTERVALS_EXISTS",
 ``!a b c d:real. ~(interval[a,b] = {})
   ==> ?p. (interval[a,b] INSERT p) division_of
   (interval[a,b] UNION interval[c,d])``,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC ``interval[c:real,d] = {}`` THENL
  [ASM_REWRITE_TAC[UNION_EMPTY] THEN ASM_MESON_TAC[DIVISION_OF_SELF],
   ALL_TAC] THEN
  ASM_CASES_TAC ``interval[a:real,b] INTER interval[c,d] = {}`` THENL
  [EXISTS_TAC ``{interval[c:real,d]}`` THEN
   ONCE_REWRITE_TAC[SET_RULE ``{a;b} = {a} UNION {b}``] THEN
   MATCH_MP_TAC DIVISION_DISJOINT_UNION THEN
   ASM_SIMP_TAC std_ss [DIVISION_OF_SELF] THEN
   MATCH_MP_TAC(SET_RULE
   ``interior s SUBSET s /\ interior t SUBSET t /\ (s INTER t = {})
     ==> (interior s INTER interior t = {})``) THEN
   ASM_REWRITE_TAC[INTERIOR_SUBSET], ALL_TAC] THEN
  SUBGOAL_THEN
  ``?u v:real. interval[a,b] INTER interval[c,d] = interval[u,v]``
   STRIP_ASSUME_TAC THENL [MESON_TAC[INTER_INTERVAL], ALL_TAC] THEN
  MP_TAC(ISPECL [``c:real``, ``d:real``, ``u:real``, ``v:real``]
   PARTIAL_DIVISION_EXTEND_1) THEN
  KNOW_TAC ``interval [(u,v)] SUBSET interval [(c,d)] /\
            (interval [(u,v)] <> {})`` THENL
  [ASM_MESON_TAC[INTER_SUBSET], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
  DISCH_THEN(X_CHOOSE_THEN ``p:(real->bool)->bool`` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC ``p DELETE interval[u:real,v]`` THEN
  SUBGOAL_THEN ``interval[a:real,b] UNION interval[c,d] =
   interval[a,b] UNION BIGUNION (p DELETE interval[u,v])``
   SUBST1_TAC THENL
  [UNDISCH_TAC ``p division_of interval [c,d]`` THEN DISCH_TAC THEN
   FIRST_ASSUM(SUBST1_TAC o SYM o last o CONJUNCTS o
   REWRITE_RULE [division_of]) THEN
   ASM_SET_TAC[], ALL_TAC] THEN
  ONCE_REWRITE_TAC[SET_RULE ``x INSERT s = {x} UNION s``] THEN
  MATCH_MP_TAC DIVISION_DISJOINT_UNION THEN
  ASM_SIMP_TAC std_ss [DIVISION_OF_SELF] THEN CONJ_TAC THENL
  [MATCH_MP_TAC DIVISION_OF_SUBSET THEN
   EXISTS_TAC ``p:(real->bool)->bool`` THEN
   ASM_MESON_TAC[DIVISION_OF_UNION_SELF, DELETE_SUBSET],
   ALL_TAC] THEN
  REWRITE_TAC[GSYM INTERIOR_INTER] THEN
  MATCH_MP_TAC EQ_TRANS THEN
  EXISTS_TAC ``interior(interval[u:real,v] INTER
   BIGUNION (p DELETE interval[u,v]))`` THEN
  CONJ_TAC THENL
  [AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE
    ``!cd. p SUBSET cd /\ (uv = ab INTER cd)
    ==> (ab INTER p = uv INTER p)``) THEN
  EXISTS_TAC ``interval[c:real,d]`` THEN
  ASM_REWRITE_TAC[BIGUNION_SUBSET, IN_DELETE] THEN
  ASM_MESON_TAC[division_of],
  REWRITE_TAC[INTERIOR_INTER] THEN
  MATCH_MP_TAC INTER_INTERIOR_BIGUNION_INTERVALS THEN
  REWRITE_TAC[IN_DELETE, OPEN_INTERIOR, FINITE_DELETE] THEN
  ASM_MESON_TAC[division_of]]);

val DIVISION_OF_BIGUNION = store_thm ("DIVISION_OF_BIGUNION",
 ``!f. FINITE f /\
  (!p. p IN f ==> p division_of (BIGUNION p)) /\
  (!k1 k2. k1 IN BIGUNION f /\ k2 IN BIGUNION f /\ ~(k1 = k2)
  ==> (interior k1 INTER interior k2 = {}))
    ==> (BIGUNION f) division_of BIGUNION (BIGUNION f)``,
REWRITE_TAC[division_of] THEN
SIMP_TAC std_ss [FINITE_BIGUNION] THEN SIMP_TAC std_ss [FORALL_IN_BIGUNION] THEN
GEN_TAC THEN SET_TAC[]);

val ELEMENTARY_UNION_INTERVAL_STRONG = store_thm ("ELEMENTARY_UNION_INTERVAL_STRONG",
 ``!p a b:real. p division_of (BIGUNION p)
    ==> ?q. p SUBSET q /\ q division_of (interval[a,b] UNION BIGUNION p)``,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC ``p:(real->bool)->bool = {}`` THENL
  [ASM_REWRITE_TAC[BIGUNION_EMPTY, UNION_EMPTY, EMPTY_SUBSET] THEN
   MESON_TAC[ELEMENTARY_INTERVAL],
   ALL_TAC] THEN
  ASM_CASES_TAC ``interval[a:real,b] = {}`` THEN
  ASM_REWRITE_TAC[UNION_EMPTY] THENL [ASM_MESON_TAC[SUBSET_REFL], ALL_TAC] THEN
  ASM_CASES_TAC ``interior(interval[a:real,b]) = {}`` THENL
  [EXISTS_TAC ``interval[a:real,b] INSERT p`` THEN
   REWRITE_TAC[division_of] THEN
   UNDISCH_TAC ``p division_of BIGUNION p`` THEN DISCH_TAC THEN
   FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
   SIMP_TAC std_ss [FINITE_INSERT, BIGUNION_INSERT] THEN ASM_SET_TAC[],
   ALL_TAC] THEN
  ASM_CASES_TAC ``interval[a:real,b] SUBSET BIGUNION p`` THENL
  [ASM_SIMP_TAC std_ss [SET_RULE ``s SUBSET t ==> (s UNION t = t)``] THEN
   ASM_MESON_TAC[SUBSET_REFL], ALL_TAC] THEN
  SUBGOAL_THEN
   ``!k:real->bool. k IN p
     ==> ?q. ~(k IN q) /\ ~(q = {}) /\
        (k INSERT q) division_of (interval[a,b] UNION k)``
     MP_TAC THENL
  [X_GEN_TAC ``k:real->bool`` THEN DISCH_TAC THEN
   UNDISCH_TAC ``p division_of BIGUNION p`` THEN DISCH_TAC THEN
   FIRST_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
   DISCH_THEN(MP_TAC o SPEC ``k:real->bool`` o CONJUNCT1 o CONJUNCT2) THEN
   ASM_REWRITE_TAC[] THEN
   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
   SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
   MAP_EVERY X_GEN_TAC [``c:real``, ``d:real``] THEN
   DISCH_THEN SUBST_ALL_TAC THEN
   ONCE_REWRITE_TAC[UNION_COMM] THEN
   MP_TAC(ISPECL [``c:real``, ``d:real``, ``a:real``, ``b:real``]
    DIVISION_UNION_INTERVALS_EXISTS) THEN
   ASM_REWRITE_TAC[] THEN
   DISCH_THEN(X_CHOOSE_TAC ``q:(real->bool)->bool``) THEN
   EXISTS_TAC ``q DELETE interval[c:real,d]`` THEN
   ASM_REWRITE_TAC[IN_DELETE, SET_RULE
    ``x INSERT (q DELETE x) = x INSERT q``] THEN
   DISCH_TAC THEN
   UNDISCH_TAC ``(interval[c:real,d] INSERT q) division_of
    (interval [c,d] UNION interval [a,b])`` THEN
   ASM_SIMP_TAC std_ss [SET_RULE ``(s DELETE x = {}) ==> (x INSERT s = {x})``] THEN
   REWRITE_TAC[division_of, BIGUNION_SING] THEN ASM_SET_TAC[], ALL_TAC] THEN
  KNOW_TAC ``(!(k :real -> bool). ?(q :(real -> bool) -> bool).
                k IN (p :(real -> bool) -> bool) ==>
                k NOTIN q /\ q <> ({} :(real -> bool) -> bool) /\
                k INSERT q division_of
                 interval [((a :real),(b :real))] UNION k) ==>
              ?(q :(real -> bool) -> bool).
       p SUBSET q /\ q division_of interval [(a,b)] UNION BIGUNION p`` THENL
  [ALL_TAC, METIS_TAC [GSYM RIGHT_EXISTS_IMP_THM]] THEN SIMP_TAC std_ss [SKOLEM_THM] THEN
  DISCH_THEN(X_CHOOSE_TAC ``q:(real->bool)->(real->bool)->bool``) THEN
  MP_TAC(ISPEC ``IMAGE (BIGUNION o (q:(real->bool)->(real->bool)->bool)) p``
   ELEMENTARY_BIGINTER) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
  ASM_SIMP_TAC std_ss [IMAGE_FINITE, IMAGE_EQ_EMPTY, FORALL_IN_IMAGE] THEN
  KNOW_TAC ``(!(x :real -> bool).
    x IN (p :(real -> bool) -> bool) ==> ?(p' :(real -> bool) -> bool).
      p' division_of BIGUNION ((q :(real -> bool) -> (real -> bool) -> bool) x))`` THENL
  [X_GEN_TAC ``k:real->bool`` THEN DISCH_TAC THEN
   EXISTS_TAC ``(q:(real->bool)->(real->bool)->bool) k`` THEN
   SIMP_TAC std_ss [o_THM] THEN MATCH_MP_TAC DIVISION_OF_SUBSET THEN
   EXISTS_TAC ``(k:real->bool) INSERT q k`` THEN
   CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_UNION_SELF], SET_TAC[]],
   DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
   DISCH_THEN(X_CHOOSE_TAC ``r:(real->bool)->bool``)] THEN
   EXISTS_TAC ``p UNION r:(real->bool)->bool`` THEN SIMP_TAC std_ss [SUBSET_UNION] THEN
   SUBGOAL_THEN
    ``interval[a:real,b] UNION BIGUNION p =
     BIGUNION p UNION BIGINTER (IMAGE (BIGUNION o q) p)``
     SUBST1_TAC THENL
   [GEN_REWR_TAC I [EXTENSION] THEN X_GEN_TAC ``y:real`` THEN
    REWRITE_TAC[IN_UNION] THEN
    ASM_CASES_TAC ``(y:real) IN BIGUNION p`` THEN ASM_REWRITE_TAC[IN_BIGINTER] THEN
    SIMP_TAC std_ss [FORALL_IN_BIGUNION, IMP_CONJ, FORALL_IN_IMAGE,
     RIGHT_FORALL_IMP_THM] THEN
    SUBGOAL_THEN
    ``!k. k IN p ==> (BIGUNION(k INSERT q k) = interval[a:real,b] UNION k)``
     MP_TAC THENL [ASM_MESON_TAC[division_of], ALL_TAC] THEN
     SIMP_TAC std_ss [BIGUNION_INSERT, o_THM] THEN
     GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EXTENSION] THEN
     SIMP_TAC std_ss [GSYM RIGHT_FORALL_IMP_THM, IN_UNION] THEN
    KNOW_TAC ``(!(x :real) (k :real -> bool).
               k IN (p :(real -> bool) -> bool) ==>
         (x IN k \/
          x IN BIGUNION ((q :(real -> bool) -> (real -> bool) -> bool) k) <=>
          x IN interval [((a :real),(b :real))] \/ x IN k)) ==>
        ((y :real) IN interval [(a,b)] <=>
        !(x :real -> bool). x IN p ==> y IN BIGUNION (q x))`` THENL
   [ALL_TAC, METIS_TAC [SWAP_FORALL_THM]] THEN
  DISCH_THEN(MP_TAC o SPEC ``y:real``) THEN
  UNDISCH_TAC ``~((y:real) IN BIGUNION p)`` THEN
  SIMP_TAC std_ss [IN_BIGUNION, NOT_EXISTS_THM, TAUT `~(a /\ b) <=> a ==> ~b`] THEN
  ASM_CASES_TAC ``(y:real) IN interval[a,b]`` THEN
  ASM_REWRITE_TAC[] THEN ASM_SET_TAC[], ALL_TAC] THEN
  MATCH_MP_TAC DIVISION_DISJOINT_UNION THEN
  ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN
  MATCH_MP_TAC INTER_INTERIOR_BIGUNION_INTERVALS THEN
  ASM_REWRITE_TAC[OPEN_INTERIOR] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[division_of], ALL_TAC] THEN
  X_GEN_TAC ``k:real->bool`` THEN DISCH_TAC THEN
  ASM_SIMP_TAC std_ss [INTERIOR_FINITE_BIGINTER, IMAGE_FINITE] THEN
  MATCH_MP_TAC(SET_RULE ``(?x. x IN p /\ (f x INTER s = {}))
   ==> (BIGINTER (IMAGE f p) INTER s = {})``) THEN
  SIMP_TAC std_ss [EXISTS_IN_IMAGE, o_THM] THEN EXISTS_TAC ``k:real->bool`` THEN
  ASM_REWRITE_TAC[] THEN
  ONCE_REWRITE_TAC[INTER_COMM] THEN
  MATCH_MP_TAC INTER_INTERIOR_BIGUNION_INTERVALS THEN
  ASM_REWRITE_TAC[OPEN_INTERIOR] THEN REPEAT CONJ_TAC THENL
  [ASM_MESON_TAC[division_of, FINITE_INSERT, IN_INSERT],
   ASM_MESON_TAC[division_of, FINITE_INSERT, IN_INSERT],
   ALL_TAC] THEN
  UNDISCH_TAC ``!k. k IN p ==> k NOTIN q k /\ q k <> {} /\
          k INSERT q k division_of interval [(a,b)] UNION k`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``k:real->bool``) THEN
  ASM_REWRITE_TAC[division_of, IN_INSERT] THEN
REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]);

val ELEMENTARY_UNION_INTERVAL = store_thm ("ELEMENTARY_UNION_INTERVAL",
 ``!p a b:real. p division_of (BIGUNION p)
   ==> ?q. q division_of (interval[a,b] UNION BIGUNION p)``,
 MESON_TAC[ELEMENTARY_UNION_INTERVAL_STRONG]);

val ELEMENTARY_BIGUNION_INTERVALS = store_thm ("ELEMENTARY_BIGUNION_INTERVALS",
 ``!f. FINITE f /\
  (!s. s IN f ==> ?a b:real. s = interval[a,b])
    ==> (?p. p division_of (BIGUNION f))``,
  REWRITE_TAC[IMP_CONJ] THEN
  KNOW_TAC ``!f. ((!s. s IN f ==> ?a b. s = interval [(a,b)]) ==>
            ?p. p division_of BIGUNION f) =
             (\f. (!s. s IN f ==> ?a b. s = interval [(a,b)]) ==>
            ?p. p division_of BIGUNION f) f`` THENL
  [SIMP_TAC std_ss [], DISC_RW_KILL] THEN
  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
  SIMP_TAC std_ss [BIGUNION_EMPTY, BIGUNION_INSERT, ELEMENTARY_EMPTY] THEN
  SIMP_TAC std_ss [GSYM RIGHT_FORALL_IMP_THM] THEN
  SIMP_TAC std_ss [IN_INSERT, TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
  SIMP_TAC std_ss [FORALL_AND_THM, LEFT_FORALL_IMP_THM, EXISTS_REFL] THEN
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC [METIS [] ``(a ==> b ==> c ==> d) =
    (c ==> a ==> b ==> d)``] THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
  SUBGOAL_THEN ``BIGUNION s:real->bool = BIGUNION p`` SUBST1_TAC THENL
  [METIS_TAC[division_of], ALL_TAC] THEN
  MATCH_MP_TAC ELEMENTARY_UNION_INTERVAL THEN ASM_MESON_TAC[division_of]);

val ELEMENTARY_UNION = store_thm ("ELEMENTARY_UNION",
 ``!s t:real->bool.
   (?p. p division_of s) /\ (?p. p division_of t)
   ==> (?p. p division_of (s UNION t))``,
  REPEAT GEN_TAC THEN DISCH_THEN
  (CONJUNCTS_THEN2 (X_CHOOSE_TAC ``p1:(real->bool)->bool``)
  (X_CHOOSE_TAC ``p2:(real->bool)->bool``)) THEN
  SUBGOAL_THEN ``s UNION t :real->bool = BIGUNION p1 UNION BIGUNION p2``
   SUBST1_TAC THENL [ASM_MESON_TAC[division_of], ALL_TAC] THEN
  REWRITE_TAC[SET_RULE ``BIGUNION p1 UNION BIGUNION p2 = BIGUNION (p1 UNION p2)``] THEN
  MATCH_MP_TAC ELEMENTARY_BIGUNION_INTERVALS THEN
  REWRITE_TAC[IN_UNION, FINITE_UNION] THEN
  ASM_MESON_TAC[division_of]);

val PARTIAL_DIVISION_EXTEND = store_thm ("PARTIAL_DIVISION_EXTEND",
 ``!p q s t:real->bool.
    p division_of s /\ q division_of t /\ s SUBSET t
    ==> ?r. p SUBSET r /\ r division_of t``,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN ``?a b:real. t SUBSET interval[a,b]`` MP_TAC THENL
  [ASM_MESON_TAC[ELEMENTARY_SUBSET_INTERVAL], ALL_TAC] THEN
  SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN DISCH_TAC THEN
  SUBGOAL_THEN ``?r1. p SUBSET r1 /\ r1 division_of interval[a:real,b]``
   STRIP_ASSUME_TAC THENL
  [MATCH_MP_TAC PARTIAL_DIVISION_EXTEND_INTERVAL THEN
   ASM_MESON_TAC[division_of, SUBSET_TRANS], ALL_TAC] THEN
  SUBGOAL_THEN ``?r2:(real->bool)->bool.
    r2 division_of (BIGUNION (r1 DIFF p)) INTER (BIGUNION q)``
    STRIP_ASSUME_TAC THENL
  [MATCH_MP_TAC ELEMENTARY_INTER THEN
   ASM_MESON_TAC[FINITE_DIFF, IN_DIFF, division_of,
    ELEMENTARY_BIGUNION_INTERVALS], ALL_TAC] THEN
  EXISTS_TAC ``p UNION r2:(real->bool)->bool`` THEN
  CONJ_TAC THENL [SET_TAC[], ALL_TAC] THEN
  SUBGOAL_THEN
   ``t:real->bool = BIGUNION p UNION (BIGUNION (r1 DIFF p) INTER BIGUNION q)``
   SUBST1_TAC THENL
  [REPEAT(FIRST_X_ASSUM(MP_TAC o last o CONJUNCTS o
    REWRITE_RULE [division_of])) THEN
  REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[],
  MATCH_MP_TAC DIVISION_DISJOINT_UNION THEN ASM_REWRITE_TAC[] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[division_of], ALL_TAC] THEN
  MATCH_MP_TAC(SET_RULE
   ``!t'. t SUBSET t' /\ (s INTER t' = {}) ==> (s INTER t = {})``) THEN
  EXISTS_TAC ``interior(BIGUNION (r1 DIFF p)):real->bool`` THEN
  CONJ_TAC THENL [MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[], ALL_TAC] THEN
  REPEAT(MATCH_MP_TAC INTER_INTERIOR_BIGUNION_INTERVALS THEN
  REWRITE_TAC[OPEN_INTERIOR] THEN REPEAT(CONJ_TAC THENL
  [ASM_MESON_TAC[IN_DIFF, FINITE_DIFF, division_of], ALL_TAC]) THEN
  REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[INTER_COMM]) THEN
  ASM_MESON_TAC[division_of, SUBSET_DEF]]);

val INTERVAL_SUBDIVISION = store_thm ("INTERVAL_SUBDIVISION",
 ``!a b c:real. c IN interval[a,b]
   ==> (IMAGE (\s. interval[(@f. f = if 1:num IN s then c else a),
                            (@f. f = if 1:num IN s then b else c)])
        {s | s SUBSET (1:num..1:num)}) division_of interval[a,b]``,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o REWRITE_RULE [IN_INTERVAL]) THEN
  REWRITE_TAC[DIVISION_OF] THEN
  SIMP_TAC std_ss [IMAGE_FINITE, FINITE_POWERSET, FINITE_NUMSEG] THEN
  SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM, FORALL_IN_IMAGE] THEN
  SIMP_TAC std_ss [FORALL_IN_GSPEC, SUBSET_INTERVAL, INTERVAL_NE_EMPTY] THEN
  REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN REPEAT CONJ_TAC THENL
  [METIS_TAC[REAL_LE_TRANS],
   X_GEN_TAC ``s:num->bool`` THEN DISCH_TAC THEN
   X_GEN_TAC ``s':num->bool`` THEN DISCH_TAC THEN
   REWRITE_TAC[SET_RULE
    ``(~p ==> (s INTER t = {})) <=> (!x. x IN s /\ x IN t ==> p)``,
      METIS [] ``(a <> b) = ~(a = b)``] THEN
   X_GEN_TAC ``x:real`` THEN SIMP_TAC std_ss [IN_INTERVAL, GSYM FORALL_AND_THM] THEN
   ASM_CASES_TAC ``s':num->bool = s`` THEN ASM_REWRITE_TAC[] THEN
   FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
    ``~(s' = s) ==> ?x. x IN s' /\ ~(x IN s) \/ x IN s /\ ~(x IN s')``)) THEN
  FULL_SIMP_TAC std_ss [NUMSEG_SING, IN_SING, SUBSET_DEF] THEN
  DISCH_THEN(X_CHOOSE_THEN ``k:num`` STRIP_ASSUME_TAC) THEN
  (POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
  POP_ASSUM (MP_TAC o Q.SPEC `k:num`) THEN POP_ASSUM (MP_TAC o Q.SPEC `k:num`) THEN
  DISCH_TAC THEN DISCH_TAC THEN DISCH_TAC THEN DISCH_TAC THEN
  FULL_SIMP_TAC std_ss [] THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
  ASM_REWRITE_TAC [] THEN DISCH_TAC THEN DISCH_TAC THEN
  ASM_REWRITE_TAC [] THEN METIS_TAC [REAL_LT_ANTISYM]),
  MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN
  GEN_REWR_TAC I [SUBSET_DEF] THENL
  [SIMP_TAC std_ss [FORALL_IN_BIGUNION] THEN
   KNOW_TAC ``(!(x :real) (t :real -> bool).
                 t IN IMAGE (\(s :num -> bool).
       interval
         [(if (1 :num) IN s then (c :real) else (a :real),
           if (1 :num) IN s then (b :real) else c)])
    {s | s SUBSET ((1 :num) .. (1 :num))} /\ x IN t ==>
                                  x IN interval [(a,b)])`` THENL
  [ALL_TAC, METIS_TAC [SWAP_FORALL_THM]] THEN
  SIMP_TAC std_ss [IMP_CONJ, FORALL_IN_IMAGE, FORALL_IN_GSPEC] THEN
  KNOW_TAC ``(!(s :num -> bool) (x :real).
          s SUBSET ((1 :num) .. (1 :num)) ==>
          x IN interval
    [(if (1 :num) IN s then (c :real) else (a :real),
      if (1 :num) IN s then (b :real) else c)] ==>
                                x IN interval [(a,b)])`` THENL
   [ALL_TAC, METIS_TAC [SWAP_FORALL_THM]] THEN
   SIMP_TAC std_ss [RIGHT_FORALL_IMP_THM, GSYM SUBSET_DEF] THEN
   SIMP_TAC std_ss [SUBSET_INTERVAL] THEN
   METIS_TAC[REAL_LE_TRANS, REAL_LE_REFL],
   X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
   REWRITE_TAC [IN_BIGUNION] THEN ONCE_REWRITE_TAC [CONJ_SYM] THEN
   SIMP_TAC std_ss [EXISTS_IN_IMAGE, EXISTS_IN_GSPEC] THEN
   EXISTS_TAC ``{i | i IN (1:num..1:num) /\ (c:real) <= (x:real)}`` THEN
   CONJ_TAC THENL [SET_TAC[], REWRITE_TAC[IN_INTERVAL]] THEN
   SIMP_TAC std_ss [GSPECIFICATION, IN_NUMSEG] THEN
   RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
   METIS_TAC[REAL_LE_TOTAL]]]);

val DIVISION_OF_NONTRIVIAL = store_thm ("DIVISION_OF_NONTRIVIAL",
 ``!s a b:real.
    s division_of interval[a,b] /\ ~(content(interval[a,b]) = &0)
    ==> {k | k IN s /\ ~(content k = &0)} division_of interval[a,b]``,
  REPEAT GEN_TAC THEN completeInduct_on `CARD(s:(real->bool)->bool)` THEN
  GEN_TAC THEN DISCH_TAC THEN FULL_SIMP_TAC std_ss [] THEN POP_ASSUM K_TAC THEN
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC ``{k:real->bool | k IN s /\ ~(content k = &0)} = s`` THEN
  ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [EXTENSION]) THEN
  SIMP_TAC std_ss [GSPECIFICATION, NOT_FORALL_THM, LEFT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[TAUT `~(a /\ ~b <=> a) <=> a /\ b`] THEN
  X_GEN_TAC ``k:real->bool`` THEN STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
  UNDISCH_TAC `` !(m :num).
        m < CARD (s :(real -> bool) -> bool) ==>
        !(s :(real -> bool) -> bool).
          (m = CARD s) ==>
          s division_of interval [((a :real),(b :real))] /\
          content (interval [(a,b)]) <> (0 :real) ==>
          {k | k IN s /\ content k <> (0 :real)} division_of
          interval [(a,b)]`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``CARD (s DELETE (k:real->bool))``) THEN
  ASM_SIMP_TAC std_ss [CARD_DELETE, ARITH_PROVE ``n - 1 < n <=> ~(n = 0:num)``] THEN
  ASM_SIMP_TAC std_ss [CARD_EQ_0] THEN
  KNOW_TAC ``(s :(real -> bool) -> bool) <> {}`` THENL [ASM_SET_TAC[],
   DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  DISCH_THEN (MP_TAC o SPEC ``(s :(real -> bool) -> bool) DELETE k``) THEN
  ASM_SIMP_TAC std_ss [CARD_DELETE, ARITH_PROVE ``n - 1 < n <=> ~(n = 0:num)``] THEN
  KNOW_TAC ``s DELETE (k:real->bool) division_of interval [(a,b)]`` THENL
  [ALL_TAC,
   DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
   MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN AP_TERM_TAC THEN
   ASM_SET_TAC[]] THEN
  REWRITE_TAC[DIVISION_OF] THEN
  UNDISCH_TAC ``s division_of interval [(a,b)]`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE [division_of]) THEN
  ASM_SIMP_TAC std_ss [FINITE_DELETE, IN_DELETE] THEN
  FIRST_ASSUM(MP_TAC o C MATCH_MP (ASSUME ``(k:real->bool) IN s``)) THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [``c:real``, ``d:real``] THEN
  DISCH_THEN SUBST_ALL_TAC THEN
  MATCH_MP_TAC(SET_RULE
   ``(BIGUNION s = i) /\ k SUBSET BIGUNION(s DELETE k)
   ==> (BIGUNION(s DELETE k) = i)``) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[CLOSED_LIMPT, SUBSET_DEF]
   ``closed s /\ (!x. x IN k ==> x limit_point_of s) ==> k SUBSET s``) THEN
  CONJ_TAC THENL
  [MATCH_MP_TAC CLOSED_BIGUNION THEN
   ASM_REWRITE_TAC[FINITE_DELETE, IN_DELETE] THEN
   ASM_MESON_TAC[CLOSED_INTERVAL],
   ALL_TAC] THEN
  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN REWRITE_TAC[dist] THEN
  SUBGOAL_THEN ``?y:real. y IN BIGUNION s /\ ~(y IN interval[c,d]) /\
   ~(y = x) /\ abs(y - x) < e``
  MP_TAC THENL [ALL_TAC, SET_TAC[]] THEN ASM_REWRITE_TAC[] THEN
  MAP_EVERY UNDISCH_TAC
  [``~(content(interval[a:real,b]) = &0)``,
     ``content(interval[c:real,d]) = &0``] THEN
  SIMP_TAC std_ss [CONTENT_EQ_0, NOT_EXISTS_THM] THEN
  DISCH_TAC THEN ASM_REWRITE_TAC[REAL_NOT_LE] THEN
  DISCH_TAC THEN UNDISCH_TAC ``~(interval[c:real,d] = {})`` THEN
  SIMP_TAC std_ss [GSYM INTERVAL_EQ_EMPTY, NOT_EXISTS_THM] THEN
  ASM_REWRITE_TAC[REAL_NOT_LT] THEN
  ASM_SIMP_TAC std_ss [REAL_ARITH ``a <= b ==> (b <= a <=> (a = b:real))``] THEN
  DISCH_THEN(fn th => SUBST_ALL_TAC th THEN ASSUME_TAC th) THEN
  UNDISCH_TAC ``interval[c:real,c] SUBSET interval[a,b]`` THEN
  REWRITE_TAC[SUBSET_DEF] THEN DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN
  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
  MP_TAC(ASSUME ``(x:real) IN interval[c,c]``) THEN
  GEN_REWR_TAC LAND_CONV [IN_INTERVAL] THEN
  ASM_REWRITE_TAC[] THEN
  ASM_SIMP_TAC std_ss [REAL_ARITH ``(d = c) ==> (c <= x /\ x <= d <=> (x = c:real))``] THEN
  DISCH_TAC THEN
  MP_TAC(ASSUME ``(x:real) IN interval[a,b]``) THEN
  GEN_REWR_TAC LAND_CONV [IN_INTERVAL] THEN ASM_REWRITE_TAC[] THEN
  STRIP_TAC THEN EXISTS_TAC
  ``(@f. f = if (c:real) <= ((a:real) + (b:real)) / &2
             then c + min e (b - c) / &2
             else c - min e (c - a) / &2)`` THEN
  SIMP_TAC std_ss [IN_INTERVAL] THEN REPEAT CONJ_TAC THENL
  [FULL_SIMP_TAC std_ss [IN_INTERVAL, min_def] THEN
   REPEAT COND_CASES_TAC THEN
   FULL_SIMP_TAC real_ss [REAL_ARITH ``a <= b - c / 2 <=> c / 2 <= b - a:real``,
    REAL_ARITH ``a <= b + c / 2 <=> a - b <= c / 2:real``,
    REAL_ARITH ``c + e / 2 <= b <=> e / 2 <= b - c:real``,
    REAL_ARITH ``c - e / 2 <= b <=> c - b <= e / 2:real``,
    REAL_LE_RDIV_EQ, REAL_LE_LDIV_EQ] THEN
   UNDISCH_TAC ``0 < e:real`` THEN POP_ASSUM MP_TAC THEN
   POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
   POP_ASSUM MP_TAC THEN REAL_ARITH_TAC,
   FULL_SIMP_TAC std_ss [IN_INTERVAL, min_def] THEN
   REPEAT COND_CASES_TAC THEN
   FULL_SIMP_TAC real_ss [REAL_ARITH ``a <= b - c / 2 <=> c / 2 <= b - a:real``,
    REAL_ARITH ``a <= b + c / 2 <=> a - b <= c / 2:real``,
    REAL_ARITH ``c + e / 2 <= b <=> e / 2 <= b - c:real``,
    REAL_ARITH ``c - e / 2 <= b <=> c - b <= e / 2:real``,
    REAL_LE_RDIV_EQ, REAL_LE_LDIV_EQ] THEN
   UNDISCH_TAC ``0 < e:real`` THEN POP_ASSUM MP_TAC THEN
   POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
   POP_ASSUM MP_TAC THEN REAL_ARITH_TAC,
   FULL_SIMP_TAC std_ss [IN_INTERVAL, min_def] THEN
   REPEAT COND_CASES_TAC THEN
   FULL_SIMP_TAC real_ss [REAL_ARITH ``a <= b - c / 2 <=> c / 2 <= b - a:real``,
    REAL_ARITH ``a <= b + c / 2 <=> a - b <= c / 2:real``,
    REAL_ARITH ``c + e / 2 <= b <=> e / 2 <= b - c:real``,
    REAL_ARITH ``c - e / 2 <= b <=> c - b <= e / 2:real``,
    REAL_LE_RDIV_EQ, REAL_LE_LDIV_EQ] THENL
    [ASM_REWRITE_TAC [REAL_NOT_LE],
     REWRITE_TAC [REAL_NOT_LE] THEN
     POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
     POP_ASSUM MP_TAC THEN UNDISCH_TAC ``a < b:real`` THEN
     UNDISCH_TAC ``0 < e:real`` THEN REAL_ARITH_TAC,
     ASM_REWRITE_TAC [REAL_NOT_LE],
     REWRITE_TAC [REAL_NOT_LE] THEN
     POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
     POP_ASSUM MP_TAC THEN UNDISCH_TAC ``a < b:real`` THEN
     UNDISCH_TAC ``0 < e:real`` THEN REAL_ARITH_TAC],
    FULL_SIMP_TAC std_ss [IN_INTERVAL, min_def] THEN
    REPEAT COND_CASES_TAC THEN
    FULL_SIMP_TAC real_ss [REAL_ARITH ``a <= b - c / 2 <=> c / 2 <= b - a:real``,
     REAL_ARITH ``a <= b + c / 2 <=> a - b <= c / 2:real``,
     REAL_ARITH ``c + e / 2 <= b <=> e / 2 <= b - c:real``,
     REAL_ARITH ``c - e / 2 <= b <=> c - b <= e / 2:real``,
     REAL_LE_RDIV_EQ, REAL_LE_LDIV_EQ] THENL
    [REWRITE_TAC [REAL_ARITH ``(a + b <> a) <=> (0 <> b:real)``] THEN
     ASM_SIMP_TAC std_ss [REAL_LT_IMP_NE, REAL_HALF],
     REWRITE_TAC [REAL_ARITH ``(a + b <> a) <=> (0 <> b:real)``] THEN
     MATCH_MP_TAC REAL_LT_IMP_NE THEN SIMP_TAC real_ss [REAL_LT_RDIV_EQ] THEN
     POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
     POP_ASSUM MP_TAC THEN UNDISCH_TAC ``a < b:real`` THEN
     UNDISCH_TAC ``0 < e:real`` THEN REAL_ARITH_TAC,
     REWRITE_TAC [REAL_ARITH ``(a - b <> a) <=> (0 <> b:real)``] THEN
     ASM_SIMP_TAC std_ss [REAL_LT_IMP_NE, REAL_HALF],
     REWRITE_TAC [REAL_ARITH ``(a - b <> a) <=> (0 <> b:real)``] THEN
     MATCH_MP_TAC REAL_LT_IMP_NE THEN SIMP_TAC real_ss [REAL_LT_RDIV_EQ] THEN
     POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
     POP_ASSUM MP_TAC THEN UNDISCH_TAC ``a < b:real`` THEN
     UNDISCH_TAC ``0 < e:real`` THEN REAL_ARITH_TAC],
   FULL_SIMP_TAC std_ss [IN_INTERVAL, min_def, abs] THEN
   REPEAT COND_CASES_TAC THEN
   FULL_SIMP_TAC real_ss [REAL_ARITH ``a <= b - c / 2 <=> c / 2 <= b - a:real``,
    REAL_ARITH ``a <= b + c / 2 <=> a - b <= c / 2:real``,
    REAL_ARITH ``c + e / 2 <= b <=> e / 2 <= b - c:real``,
    REAL_ARITH ``c - e / 2 <= b <=> c - b <= e / 2:real``,
    REAL_LE_RDIV_EQ, REAL_LE_LDIV_EQ, REAL_LT_RDIV_EQ, REAL_LT_LDIV_EQ] THENL
   [UNDISCH_TAC ``0 < e:real`` THEN REAL_ARITH_TAC,
    POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
     POP_ASSUM MP_TAC THEN UNDISCH_TAC ``a < b:real`` THEN
     UNDISCH_TAC ``0 < e:real`` THEN REAL_ARITH_TAC,
    REWRITE_TAC [REAL_ARITH ``a - b - a < e <=> -e < b:real``] THEN
    SIMP_TAC real_ss [REAL_LT_RDIV_EQ] THEN
    UNDISCH_TAC ``0 < e:real`` THEN REAL_ARITH_TAC,
    REWRITE_TAC [REAL_ARITH ``a - b - a < e <=> -e < b:real``] THEN
    SIMP_TAC real_ss [REAL_LT_RDIV_EQ] THEN
     POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
     POP_ASSUM MP_TAC THEN UNDISCH_TAC ``a < b:real`` THEN
     UNDISCH_TAC ``0 < e:real`` THEN REAL_ARITH_TAC,
    REWRITE_TAC [REAL_ARITH ``a - (a + b) < e <=> -e < b:real``] THEN
     SIMP_TAC real_ss [REAL_LT_RDIV_EQ] THEN
    UNDISCH_TAC ``0 < e:real`` THEN REAL_ARITH_TAC,
    REWRITE_TAC [REAL_ARITH ``a - (a + b) < e <=> -e < b:real``] THEN
     SIMP_TAC real_ss [REAL_LT_RDIV_EQ] THEN
    POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
     POP_ASSUM MP_TAC THEN UNDISCH_TAC ``a < b:real`` THEN
     UNDISCH_TAC ``0 < e:real`` THEN REAL_ARITH_TAC,
     UNDISCH_TAC ``0 < e:real`` THEN REAL_ARITH_TAC,
     POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
     POP_ASSUM MP_TAC THEN UNDISCH_TAC ``a < b:real`` THEN
     UNDISCH_TAC ``0 < e:real`` THEN REAL_ARITH_TAC]]);

val DIVISION_OF_AFFINITY = store_thm ("DIVISION_OF_AFFINITY",
 ``!d s:real->bool m c.
    IMAGE (IMAGE (\x. m * x + c)) d division_of (IMAGE (\x. m * x + c) s) <=>
    if m = &0 then if s = {} then (d = {})
                   else ~(d = {}) /\ !k. k IN d ==> ~(k = {})
    else d division_of s``,
  REPEAT GEN_TAC THEN ASM_CASES_TAC ``m = &0:real`` THEN ASM_REWRITE_TAC[] THENL
  [ASM_CASES_TAC ``s:real->bool = {}`` THEN
   ASM_REWRITE_TAC[IMAGE_EMPTY, IMAGE_INSERT, DIVISION_OF_TRIVIAL, IMAGE_EQ_EMPTY] THEN
   ASM_CASES_TAC ``d:(real->bool)->bool = {}`` THEN
   ASM_REWRITE_TAC[IMAGE_EMPTY, IMAGE_INSERT, EMPTY_DIVISION_OF, BIGUNION_EMPTY,
    IMAGE_EQ_EMPTY] THEN
   REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_LID] THEN
   ASM_SIMP_TAC std_ss [SET_RULE ``~(s = {}) ==> (IMAGE (\x. c) s = {c})``] THEN
   ASM_CASES_TAC ``!k:real->bool. k IN d ==> ~(k = {})`` THEN
   ASM_REWRITE_TAC[division_of] THENL
   [ALL_TAC,
    SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN ASM_MESON_TAC[IMAGE_EQ_EMPTY]] THEN
   SUBGOAL_THEN
    ``IMAGE (IMAGE ((\x. c):real->real)) d = {{c}}``
    SUBST1_TAC THENL
   [GEN_REWR_TAC I [EXTENSION] THEN
    REWRITE_TAC[IN_IMAGE, IN_SING] THEN ASM_SET_TAC[],
    SIMP_TAC std_ss [BIGUNION_SING, FINITE_SING, IN_SING, IMP_CONJ] THEN
    REWRITE_TAC[SUBSET_REFL, NOT_INSERT_EMPTY] THEN
    METIS_TAC[INTERVAL_SING]],
  REWRITE_TAC[division_of] THEN
  SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM, FORALL_IN_IMAGE] THEN
  REWRITE_TAC[IMAGE_EQ_EMPTY, GSYM INTERIOR_INTER] THEN
  ASM_SIMP_TAC std_ss [FINITE_IMAGE_INJ_EQ, GSYM IMAGE_BIGUNION,
   REAL_ARITH ``(x + a:real = y + a) <=> (x = y)``, REAL_EQ_LMUL,
   SET_RULE ``(!x y. (f x = f y) <=> (x = y))
    ==> (IMAGE f s SUBSET IMAGE f t <=> s SUBSET t) /\
        ((IMAGE f s = IMAGE f t) <=> (s = t)) /\
         (IMAGE f s INTER IMAGE f t = IMAGE f (s INTER t))``] THEN
  AP_TERM_TAC THEN BINOP_TAC THENL
  [AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
   EQ_TAC THEN SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
   MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN DISCH_TAC THEN
   ASM_SIMP_TAC std_ss [IMAGE_AFFINITY_INTERVAL] THENL [ALL_TAC, METIS_TAC[]] THEN
   FIRST_X_ASSUM(MP_TAC o AP_TERM
   ``IMAGE (\x:real. inv m * x + -(inv m * c))``) THEN
   ASM_SIMP_TAC std_ss [GSYM IMAGE_COMPOSE, AFFINITY_INVERSES] THEN
   ASM_REWRITE_TAC[IMAGE_ID, IMAGE_AFFINITY_INTERVAL] THEN METIS_TAC[],
   SUBGOAL_THEN ``(\x:real. m * x + c) = (\x. c + x) o (\x. m * x)``
   SUBST1_TAC THENL
   [SIMP_TAC std_ss [FUN_EQ_THM, o_THM] THEN REAL_ARITH_TAC,
    ASM_SIMP_TAC std_ss [IMAGE_COMPOSE, INTERIOR_TRANSLATION] THEN
    ASM_SIMP_TAC std_ss [INTERIOR_INJECTIVE_LINEAR_IMAGE, LINEAR_SCALING,
    REAL_EQ_LMUL, IMAGE_EQ_EMPTY]]]]);

val DIVISION_OF_TRANSLATION = store_thm ("DIVISION_OF_TRANSLATION",
 ``!d s:real->bool.
    IMAGE (IMAGE (\x. a + x)) d division_of (IMAGE (\x. a + x) s) <=>
     d division_of s``,
  ONCE_REWRITE_TAC[REAL_ARITH ``a + x:real = &1 * x + a:real``] THEN
  SIMP_TAC real_ss [DIVISION_OF_AFFINITY]);

val DIVISION_OF_REFLECT = store_thm ("DIVISION_OF_REFLECT",
``!d s:real->bool.
  IMAGE (IMAGE (\x. -x)) d division_of IMAGE (\x. -x) s <=>
   d division_of s``,
  REPEAT GEN_TAC THEN SUBGOAL_THEN ``(\x. -x) = \x:real. -(&1) * x + 0``
  SUBST1_TAC THENL
  [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC,
   SIMP_TAC real_ss [DIVISION_OF_AFFINITY]]);

val ELEMENTARY_COMPACT = store_thm ("ELEMENTARY_COMPACT",
 ``!s. (?d. d division_of s) ==> compact s``,
  REWRITE_TAC[division_of] THEN
  MESON_TAC[COMPACT_BIGUNION, COMPACT_INTERVAL]);

Theorem DIVISION_1_SORT :
    !d s:real->bool. d division_of s /\
     (!k. k IN d ==> ~(interior k = {}))
      ==> ?n t. (IMAGE t ((1:num)..n) = d) /\
      !i j. i IN ((1:num)..n) /\ j IN ((1:num)..n) /\ i < j
      ==> ~(t i = t j) /\
     !x y. x IN t i /\ y IN t j ==> x <= y
Proof
  REPEAT STRIP_TAC THEN EXISTS_TAC ``CARD(d:(real->bool)->bool)`` THEN
  MP_TAC(ISPEC ``\i j:real->bool. i IN d /\ j IN d /\
   (interval_lowerbound i) <= (interval_lowerbound j)``
   TOPOLOGICAL_SORT) THEN
  SIMP_TAC std_ss [] THEN
  KNOW_TAC ``(!(x :real -> bool) (y :real -> bool).
    (x IN (d :(real -> bool) -> bool) /\ y IN d /\
     interval_lowerbound x <= interval_lowerbound y) /\ y IN d /\
    x IN d /\ interval_lowerbound y <= interval_lowerbound x ==>
    (x = y)) /\
 (!(x :real -> bool) (y :real -> bool) (z :real -> bool).
    (x IN d /\ y IN d /\
     interval_lowerbound x <= interval_lowerbound y) /\ y IN d /\
    z IN d /\ interval_lowerbound y <= interval_lowerbound z ==>
    interval_lowerbound x <= interval_lowerbound z)`` THENL
  [CONJ_TAC THENL [ALL_TAC, MESON_TAC[REAL_LE_TRANS]] THEN
   SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM],
   DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
   DISCH_THEN(MP_TAC o SPECL
   [``CARD(d:(real->bool)->bool)``, ``d:(real->bool)->bool``]) THEN
   FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
   ASM_REWRITE_TAC[GSYM FINITE_HAS_SIZE] THEN
   DISCH_THEN (X_CHOOSE_TAC ``f:num->real->bool``) THEN
   EXISTS_TAC ``f:num->real->bool`` THEN POP_ASSUM MP_TAC THEN
   DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
   SUBGOAL_THEN
    ``!k l. k IN d /\ l IN d /\
     ~((interval_lowerbound l) <= (interval_lowerbound k))
      ==> ~(k = l) /\
      !x y. x IN k /\ y IN l ==> x <= y`` MP_TAC THENL
   [ALL_TAC,
    DISCH_TAC THEN
    CONJ_TAC THENL [ASM_SET_TAC[], REPEAT GEN_TAC THEN STRIP_TAC] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SET_TAC[]] THEN
    SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM]] THEN
    UNDISCH_TAC ``d division_of s`` THEN DISCH_TAC THEN
    FIRST_ASSUM(fn th =>
    SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN
    SIMP_TAC std_ss [INTERVAL_LOWERBOUND_NONEMPTY] THEN
    REWRITE_TAC[INTERVAL_NE_EMPTY, IN_INTERVAL] THEN
    MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN STRIP_TAC THEN
    MAP_EVERY X_GEN_TAC [``a':real``, ``b':real``] THEN STRIP_TAC THEN
    REPEAT STRIP_TAC THEN
    UNDISCH_TAC ``d division_of s`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
    DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
    DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
    DISCH_THEN (CONJUNCTS_THEN2 MP_TAC K_TAC) THEN
    DISCH_THEN(MP_TAC o SPECL
     [``interval[a:real,b]``, ``interval[a':real,b']``]) THEN
    (SUBGOAL_THEN
     ``~(interior(interval[a:real,b]) = {}) /\
       ~(interior(interval[a':real,b']) = {})``
     MP_TAC THENL [ASM_MESON_TAC[], ALL_TAC]) THEN
    ASM_REWRITE_TAC [EQ_INTERVAL, GSYM INTERIOR_INTER] THEN
    REWRITE_TAC [INTER_INTERVAL, INTERIOR_INTERVAL, GSYM INTERVAL_EQ_EMPTY] THEN
    ASM_SIMP_TAC real_ss [min_def, max_def] THENL
   [ (* goal 1 (of 3) *)
     Cases_on `b <= b'` >> rw [] \\
     Cases_on `(a = a') /\ (b = b')` >- rw [] \\
     ONCE_REWRITE_TAC [DISJ_COMM] >> STRONG_DISJ2_TAC \\
    `b <= a'` by PROVE_TAC [real_lte] \\
     METIS_TAC [REAL_LE_ANTISYM],
     (* goal 2 (of 3) *)
     rw [GSYM real_lte] \\
     STRONG_DISJ2_TAC >> CCONTR_TAC >> fs [GSYM real_lte],
     (* goal 3 (of 3) *)
     rpt STRIP_TAC \\
     MATCH_MP_TAC REAL_LE_TRANS \\
     Q.EXISTS_TAC `b` >> art [] \\
     MATCH_MP_TAC REAL_LE_TRANS \\
     Q.EXISTS_TAC `a'` >> art [] \\
     Cases_on `b <= b'` >> Cases_on `a <= a'` >> fs [] (* 4 goals *)
     >- (FIRST_X_ASSUM MATCH_MP_TAC \\
         CONJ_TAC >- (DISJ1_TAC >> rw [GSYM real_lte]) \\
         STRONG_DISJ2_TAC >> CCONTR_TAC >> fs [GSYM real_lte])
     >> (fs [real_lte] >> PROVE_TAC [REAL_LT_ANTISYM]) ]
QED

(* ------------------------------------------------------------------------- *)
(* Tagged (partial) divisions.                                               *)
(* ------------------------------------------------------------------------- *)

val _ = set_fixity "tagged_partial_division_of" (Infix(NONASSOC, 450));
val _ = set_fixity "tagged_division_of" (Infix(NONASSOC, 450));

val tagged_partial_division_of = new_definition ("tagged_partial_division_of",
  ``s tagged_partial_division_of i <=>
        FINITE s /\
        (!x k. (x,k) IN s
               ==> x IN k /\ k SUBSET i /\ ?a b. k = interval[a,b]) /\
        (!x1 k1 x2 k2. (x1,k1) IN s /\ (x2,k2) IN s /\ ~((x1,k1) = (x2,k2))
                       ==> (interior(k1) INTER interior(k2) = {}))``);

val tagged_division_of = new_definition ("tagged_division_of",
  ``s tagged_division_of i <=>
        s tagged_partial_division_of i /\ (BIGUNION {k | ?x. (x,k) IN s} = i)``);

val TAGGED_DIVISION_OF_FINITE = store_thm ("TAGGED_DIVISION_OF_FINITE",
 ``!s i. s tagged_division_of i ==> FINITE s``,
  SIMP_TAC std_ss [tagged_division_of, tagged_partial_division_of]);

Theorem TAGGED_DIVISION_OF :
    !s i. s tagged_division_of i <=>
        FINITE s /\
        (!x k. (x,k) IN s
               ==> x IN k /\ k SUBSET i /\ ?a b. k = interval[a,b]) /\
        (!x1 k1 x2 k2. (x1,k1) IN s /\ (x2,k2) IN s /\ ~((x1,k1) = (x2,k2))
                       ==> (interior(k1) INTER interior(k2) = {})) /\
        (BIGUNION {k | ?x. (x,k) IN s} = i)
Proof
    REWRITE_TAC[tagged_division_of, tagged_partial_division_of, CONJ_ASSOC]
QED

val DIVISION_OF_TAGGED_DIVISION = store_thm ("DIVISION_OF_TAGGED_DIVISION",
 ``!s i. s tagged_division_of i ==> (IMAGE SND s) division_of i``,
  REWRITE_TAC[TAGGED_DIVISION_OF, division_of] THEN
  ASM_SIMP_TAC std_ss [IMAGE_FINITE, FORALL_IN_IMAGE, FORALL_PROD, PAIR_EQ] THEN
  SIMP_TAC std_ss [IN_IMAGE, EXISTS_PROD] THEN
  REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL
   [ASM_MESON_TAC[MEMBER_NOT_EMPTY],
    REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[],
    SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, IN_IMAGE, IN_BIGUNION] THEN
    SIMP_TAC std_ss [FORALL_PROD, EXISTS_PROD] THEN MESON_TAC[]]);

val PARTIAL_DIVISION_OF_TAGGED_DIVISION = store_thm ("PARTIAL_DIVISION_OF_TAGGED_DIVISION",
 ``!s i. s tagged_partial_division_of i
         ==> (IMAGE SND s) division_of BIGUNION(IMAGE SND s)``,
  REWRITE_TAC[tagged_partial_division_of, division_of] THEN
  SIMP_TAC std_ss [GSYM AND_IMP_INTRO, RIGHT_FORALL_IMP_THM, FORALL_IN_IMAGE] THEN
  SIMP_TAC std_ss [FORALL_PROD, PAIR_EQ, DE_MORGAN_THM] THEN
  GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN REPEAT DISCH_TAC THEN
  REPEAT CONJ_TAC THENL
   [ASM_MESON_TAC[IMAGE_FINITE],
    ALL_TAC,
    ASM_MESON_TAC[]] THEN
  REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL
   [ALL_TAC, ASM_MESON_TAC[MEMBER_NOT_EMPTY]] THEN
  SIMP_TAC std_ss [SUBSET_DEF, IN_BIGUNION, IN_IMAGE, EXISTS_PROD] THEN
  REPEAT (POP_ASSUM MP_TAC) THEN SET_TAC[]);

val TAGGED_PARTIAL_DIVISION_SUBSET = store_thm ("TAGGED_PARTIAL_DIVISION_SUBSET",
 ``!s t i. s tagged_partial_division_of i /\ t SUBSET s
           ==> t tagged_partial_division_of i``,
  REWRITE_TAC[tagged_partial_division_of] THEN
  MESON_TAC[SUBSET_FINITE, SUBSET_DEF]);

val SUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA = store_thm ("SUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA",
 ``!d:(real->bool)->real p i.
        p tagged_partial_division_of i /\
        (!u v. ~(interval[u,v] = {}) /\ (content(interval[u,v]) = &0)
               ==> (d(interval[u,v]) = &0))
        ==> (sum p (\(x,k). d k) = sum (IMAGE SND p) d)``,
  REWRITE_TAC[CONTENT_EQ_0_INTERIOR] THEN REPEAT STRIP_TAC THEN
  SUBGOAL_THEN ``(\(x:real,k:real->bool). d k:real) = d o SND``
  SUBST1_TAC THENL [SIMP_TAC std_ss [FUN_EQ_THM, FORALL_PROD, o_THM], ALL_TAC] THEN
  CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_IMAGE_NONZERO THEN
  UNDISCH_TAC ``p tagged_partial_division_of i`` THEN
  REWRITE_TAC [tagged_partial_division_of] THEN
  MATCH_MP_TAC MONO_AND THEN SIMP_TAC std_ss [FORALL_PROD] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN DISCH_TAC THEN
  X_GEN_TAC ``x:real`` THEN X_GEN_TAC ``k:real->bool`` THEN
  X_GEN_TAC ``y:real`` THEN
  POP_ASSUM (MP_TAC o Q.SPECL [`x:real`, `k:real->bool`, `y:real`, `k:real->bool`]) THEN
  ASM_REWRITE_TAC[PAIR_EQ, INTER_IDEMPOT] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN
  ASM_MESON_TAC[]);

val SUM_OVER_TAGGED_DIVISION_LEMMA = store_thm ("SUM_OVER_TAGGED_DIVISION_LEMMA",
 ``!d:(real->bool)->real p i.
        p tagged_division_of i /\
        (!u v. ~(interval[u,v] = {}) /\ (content(interval[u,v]) = &0)
               ==> (d(interval[u,v]) = &0))
        ==> (sum p (\(x,k). d k) = sum (IMAGE SND p) d)``,
  REWRITE_TAC[tagged_division_of] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC SUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA THEN
  EXISTS_TAC ``i:real->bool`` THEN ASM_REWRITE_TAC[]);

val TAG_IN_INTERVAL = store_thm ("TAG_IN_INTERVAL",
 ``!p i k. p tagged_division_of i /\ (x,k) IN p ==> x IN i``,
  REWRITE_TAC[TAGGED_DIVISION_OF] THEN SET_TAC[]);

val TAGGED_DIVISION_OF_EMPTY = store_thm ("TAGGED_DIVISION_OF_EMPTY",
 ``{} tagged_division_of {}``,
  REWRITE_TAC[tagged_division_of, tagged_partial_division_of] THEN
  SIMP_TAC std_ss [FINITE_EMPTY, EXTENSION, NOT_IN_EMPTY, IN_BIGUNION, GSPECIFICATION]);

val TAGGED_PARTIAL_DIVISION_OF_TRIVIAL = store_thm ("TAGGED_PARTIAL_DIVISION_OF_TRIVIAL",
 ``!p. p tagged_partial_division_of {} <=> (p = {})``,
  REWRITE_TAC[tagged_partial_division_of, SUBSET_EMPTY, CONJ_ASSOC] THEN
  REWRITE_TAC[SET_RULE ``x IN k /\ (k = {}) <=> F``] THEN
  SIMP_TAC std_ss [GSYM FORALL_PROD] THEN
  REWRITE_TAC [GSYM NOT_EXISTS_THM, MEMBER_NOT_EMPTY] THEN
  REWRITE_TAC[METIS [] ``(a /\ b) /\ c <=> b /\ a /\ c``] THEN
  REWRITE_TAC [METIS [GSYM NOT_EXISTS_THM, MEMBER_NOT_EMPTY]
                      ``(!k. k NOTIN s) = (s = {})``] THEN
  GEN_TAC THEN MATCH_MP_TAC(TAUT `(a ==> b) ==> (a /\ b <=> a)`) THEN
  DISCH_THEN SUBST1_TAC THEN
  REWRITE_TAC[FINITE_EMPTY, BIGUNION_EMPTY, NOT_IN_EMPTY]);

val TAGGED_DIVISION_OF_TRIVIAL = store_thm ("TAGGED_DIVISION_OF_TRIVIAL",
 ``!p. p tagged_division_of {} <=> (p = {})``,
  REWRITE_TAC[tagged_division_of, TAGGED_PARTIAL_DIVISION_OF_TRIVIAL] THEN
  GEN_TAC THEN MATCH_MP_TAC(TAUT `(a ==> b) ==> (a /\ b <=> a)`) THEN
  DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[NOT_IN_EMPTY] THEN SET_TAC[]);

val TAGGED_DIVISION_OF_SELF = store_thm ("TAGGED_DIVISION_OF_SELF",
 ``!x a b. x IN interval[a,b]
           ==> {(x,interval[a,b])} tagged_division_of interval[a,b]``,
  REWRITE_TAC[TAGGED_DIVISION_OF, FINITE_INSERT, FINITE_EMPTY, IN_SING] THEN
  SIMP_TAC std_ss [FORALL_PROD, PAIR_EQ] THEN REPEAT STRIP_TAC THEN
  ASM_REWRITE_TAC[SUBSET_REFL, UNWIND_THM2, SET_RULE ``{k | k = a} = {a}``] THEN
  REWRITE_TAC[BIGUNION_SING] THEN ASM_MESON_TAC[]);

val TAGGED_DIVISION_UNION = store_thm ("TAGGED_DIVISION_UNION",
 ``!s1 s2:real->bool p1 p2.
        p1 tagged_division_of s1 /\
        p2 tagged_division_of s2 /\
        (interior s1 INTER interior s2 = {})
        ==> (p1 UNION p2) tagged_division_of (s1 UNION s2)``,
  REPEAT GEN_TAC THEN REWRITE_TAC[TAGGED_DIVISION_OF] THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[FINITE_UNION, IN_UNION, EXISTS_OR_THM, SET_RULE
   ``BIGUNION {x | P x \/ Q x} = BIGUNION {x | P x} UNION BIGUNION {x | Q x}``] THEN
  CONJ_TAC THENL [REPEAT (POP_ASSUM MP_TAC) THEN SET_TAC[], ALL_TAC] THEN
  REPEAT STRIP_TAC THENL
   [ASM_MESON_TAC[], ALL_TAC, ALL_TAC, ASM_MESON_TAC[],
    REPEAT (POP_ASSUM MP_TAC) THEN SET_TAC []] THEN
  MATCH_MP_TAC(SET_RULE
   ``!s' t'. s SUBSET s' /\ t SUBSET t' /\ (s' INTER t' = {})
            ==> (s INTER t = {})``) THENL
  [MAP_EVERY EXISTS_TAC
   [``interior s1:real->bool``, ``interior s2:real->bool``],
   MAP_EVERY EXISTS_TAC
   [``interior s2:real->bool``, ``interior s1:real->bool``]] THEN
  ASM_SIMP_TAC std_ss[INTER_COMM] THEN CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN
  ASM_MESON_TAC[]);

val lemma1 = Q.prove (
   `!x' k. (?s. (x',k) IN s /\ ?x. (s = pfn x) /\ x IN iset) <=>
           (?x. x IN iset /\ (x',k) IN pfn x)`,
    MESON_TAC []);

val lemma2 = Q.prove (
   `!s1 t1 s2 t2. s1 SUBSET t1 /\ s2 SUBSET t2 /\ (t1 INTER t2 = {})
                   ==> (s1 INTER s2 = {})`,
    SET_TAC []);

val TAGGED_DIVISION_BIGUNION = store_thm ("TAGGED_DIVISION_BIGUNION",
 ``!iset pfn. FINITE iset /\
              (!i:real->bool. i IN iset ==> pfn(i) tagged_division_of i) /\
              (!i1 i2. i1 IN iset /\ i2 IN iset /\ ~(i1 = i2)
                       ==> (interior(i1) INTER interior(i2) = {}))
              ==> BIGUNION(IMAGE pfn iset) tagged_division_of (BIGUNION iset)``,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[ONCE_REWRITE_RULE[EXTENSION] tagged_division_of] THEN
  SIMP_TAC std_ss [tagged_partial_division_of, IN_BIGUNION, GSPECIFICATION] THEN
  SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION, IN_BIGUNION, IN_IMAGE] THEN
  SIMP_TAC std_ss [FINITE_BIGUNION, IMAGE_FINITE, FORALL_IN_IMAGE] THEN
  STRIP_TAC THEN REPEAT CONJ_TAC THENL
   [ASM_MESON_TAC[], ALL_TAC, ASM_MESON_TAC[]] THEN
  REPEAT GEN_TAC THEN REWRITE_TAC[lemma1] THEN
  SIMP_TAC std_ss [GSYM LEFT_EXISTS_AND_THM] THEN
  SIMP_TAC std_ss [GSYM RIGHT_EXISTS_AND_THM] THEN
  RW_TAC std_ss [] THENL [ASM_CASES_TAC ``x = x':real->bool`` THENL
   [ASM_MESON_TAC[], ALL_TAC], ASM_CASES_TAC ``x = x':real->bool`` THENL
   [ASM_MESON_TAC[], ALL_TAC]] THEN MATCH_MP_TAC lemma2 THEN
  MAP_EVERY EXISTS_TAC
   [``interior(x:real->bool)``, ``interior(x':real->bool)``] THEN
  ASM_MESON_TAC[SUBSET_DEF, SUBSET_INTERIOR]);

val TAGGED_PARTIAL_DIVISION_OF_UNION_SELF = store_thm ("TAGGED_PARTIAL_DIVISION_OF_UNION_SELF",
 ``!p s. p tagged_partial_division_of s
         ==> p tagged_division_of (BIGUNION(IMAGE SND p))``,
  SIMP_TAC std_ss [tagged_partial_division_of, TAGGED_DIVISION_OF] THEN
  REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL
   [REPEAT STRIP_TAC THENL [ALL_TAC, ASM_MESON_TAC[]] THEN
    SIMP_TAC std_ss [SUBSET_DEF, IN_BIGUNION, IN_IMAGE, EXISTS_PROD] THEN
    ASM_MESON_TAC[], ASM_MESON_TAC[],
    AP_TERM_TAC THEN GEN_REWR_TAC I [EXTENSION] THEN
    SIMP_TAC std_ss [GSPECIFICATION, IN_IMAGE, EXISTS_PROD] THEN MESON_TAC[]]);

val TAGGED_DIVISION_OF_UNION_SELF = store_thm ("TAGGED_DIVISION_OF_UNION_SELF",
 ``!p s. p tagged_division_of s
         ==> p tagged_division_of (BIGUNION(IMAGE SND p))``,
  SIMP_TAC std_ss [TAGGED_DIVISION_OF] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC(TAUT `(c ==> a /\ b) /\ c ==> a /\ b /\ c`) THEN CONJ_TAC THENL
   [DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC std_ss [] THEN ASM_MESON_TAC[],
    AP_TERM_TAC THEN GEN_REWR_TAC I [EXTENSION] THEN
    SIMP_TAC std_ss [GSPECIFICATION, IN_IMAGE, EXISTS_PROD]]);

val TAGGED_DIVISION_UNION_IMAGE_SND = store_thm ("TAGGED_DIVISION_UNION_IMAGE_SND",
 ``!p s. p tagged_division_of s ==> (s = BIGUNION(IMAGE SND p))``,
  METIS_TAC[TAGGED_PARTIAL_DIVISION_OF_UNION_SELF, tagged_division_of]);

val TAGGED_DIVISION_OF_ALT = store_thm ("TAGGED_DIVISION_OF_ALT",
 ``!p s. p tagged_division_of s <=>
         p tagged_partial_division_of s /\
         (!x. x IN s ==> ?t k. (t,k) IN p /\ x IN k)``,
  REWRITE_TAC[tagged_division_of, GSYM SUBSET_ANTISYM] THEN
  SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION] THEN
  SIMP_TAC std_ss [IN_BIGUNION, EXISTS_PROD, GSPECIFICATION] THEN
  REWRITE_TAC[tagged_partial_division_of, SUBSET_DEF] THEN SET_TAC[]);

val TAGGED_DIVISION_OF_ANOTHER = store_thm ("TAGGED_DIVISION_OF_ANOTHER",
 ``!p s s'.
        p tagged_partial_division_of s' /\
        (!t k. (t,k) IN p ==> k SUBSET s) /\
        (!x. x IN s ==> ?t k. (t,k) IN p /\ x IN k)
        ==> p tagged_division_of s``,
  REWRITE_TAC[TAGGED_DIVISION_OF_ALT, tagged_partial_division_of] THEN
  SET_TAC[]);

val TAGGED_PARTIAL_DIVISION_OF_SUBSET = store_thm ("TAGGED_PARTIAL_DIVISION_OF_SUBSET",
 ``!p s t. p tagged_partial_division_of s /\ s SUBSET t
           ==> p tagged_partial_division_of t``,
  REWRITE_TAC[tagged_partial_division_of] THEN SET_TAC[]);

val TAGGED_DIVISION_OF_NONTRIVIAL = store_thm ("TAGGED_DIVISION_OF_NONTRIVIAL",
 ``!s a b:real.
        s tagged_division_of interval[a,b] /\ ~(content(interval[a,b]) = &0)
        ==> {(x,k) | (x,k) IN s /\ ~(content k = &0)}
            tagged_division_of interval[a,b]``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[TAGGED_DIVISION_OF_ALT] THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC TAGGED_PARTIAL_DIVISION_SUBSET THEN
    EXISTS_TAC ``s:(real#(real->bool))->bool`` THEN
    RULE_ASSUM_TAC(REWRITE_RULE[tagged_division_of]) THEN
    ASM_REWRITE_TAC[] THEN SRW_TAC [][SUBSET_DEF] THEN ASM_REWRITE_TAC [],
    FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_OF_TAGGED_DIVISION) THEN
    DISCH_THEN(MP_TAC o
     MATCH_MP(REWRITE_RULE[GSYM AND_IMP_INTRO] DIVISION_OF_NONTRIVIAL)) THEN
    ASM_SIMP_TAC std_ss [] THEN
    REWRITE_TAC[division_of] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN
    SIMP_TAC std_ss [GSYM SUBSET_ANTISYM_EQ, SUBSET_DEF, IN_ELIM_PAIR_THM] THEN
    SIMP_TAC real_ss [BIGUNION, EXISTS_IN_IMAGE, EXISTS_PROD, GSPECIFICATION,
                GSYM CONJ_ASSOC, LAMBDA_PROD]]);

(* ------------------------------------------------------------------------- *)
(* Fine-ness of a partition w.r.t. a gauge.                                  *)
(* ------------------------------------------------------------------------- *)

val _ = set_fixity "FINE" (Infix(NONASSOC, 450));

val FINE = new_definition ("FINE",
  ``d FINE s <=> !x k. (x,k) IN s ==> k SUBSET d(x)``);

val FINE_INTER = store_thm ("FINE_INTER",
 ``!p d1 d2. (\x. d1(x) INTER d2(x)) FINE p <=> d1 FINE p /\ d2 FINE p``,
  KNOW_TAC ``s SUBSET (t INTER u) <=> s SUBSET t /\ s SUBSET u`` THEN
  SIMP_TAC std_ss [FINE, IN_INTER, SUBSET_INTER] THEN MESON_TAC[]);

val FINE_BIGINTER = store_thm ("FINE_BIGINTER",
 ``!f s p. (\x. BIGINTER {f d x | d IN s}) FINE p <=>
           !d. d IN s ==> (f d) FINE p``,
  SIMP_TAC std_ss [FINE, SET_RULE ``s SUBSET BIGINTER u <=> !t. t IN u ==> s SUBSET t``,
              GSPECIFICATION] THEN MESON_TAC[]);

val FINE_UNION = store_thm ("FINE_UNION",
 ``!d p1 p2. d FINE p1 /\ d FINE p2 ==> d FINE (p1 UNION p2)``,
  REWRITE_TAC[FINE, IN_UNION] THEN MESON_TAC[]);

val FINE_BIGUNION = store_thm ("FINE_BIGUNION",
 ``!d ps. (!p. p IN ps ==> d FINE p) ==> d FINE (BIGUNION ps)``,
  REWRITE_TAC[FINE, IN_BIGUNION] THEN MESON_TAC[]);

val FINE_SUBSET = store_thm ("FINE_SUBSET",
 ``!d p q. p SUBSET q /\ d FINE q ==> d FINE p``,
  REWRITE_TAC[FINE, SUBSET_DEF] THEN MESON_TAC[]);

(* ------------------------------------------------------------------------- *)
(* Gauge integral. Define on compact intervals first, then use a limit.      *)
(* ------------------------------------------------------------------------- *)

val _ = set_fixity "has_integral_compact_interval" (Infix(NONASSOC, 450));
val _ = set_fixity "has_integral" (Infix(NONASSOC, 450));
val _ = set_fixity "integrable_on" (Infix(NONASSOC, 450));

val has_integral_compact_interval = new_definition ("has_integral_compact_interval",
  ``(f has_integral_compact_interval y) i <=>
        !e. &0 < e
            ==> ?d. gauge d /\
                    !p. p tagged_division_of i /\ d FINE p
                        ==> abs(sum p (\(x,k). content(k) * f(x)) - y) < e``);

val has_integral_def = new_definition ("has_integral_def",
  ``(f has_integral y) i <=>
        if ?a b. i = interval[a,b] then (f has_integral_compact_interval y) i
        else !e. &0 < e
                 ==> ?B. &0 < B /\
                         !a b. ball(0,B) SUBSET interval[a,b]
                               ==> ?z. ((\x. if x IN i then f(x) else 0)
                                        has_integral_compact_interval z)
                                        (interval[a,b]) /\ abs(z - y) < e``);;

val has_integral = store_thm ("has_integral",
 ``(f has_integral y) (interval[a,b]) <=>
        !e. &0 < e
            ==> ?d. gauge d /\
                    !p. p tagged_division_of interval[a,b] /\ d FINE p
                        ==> abs(sum p (\(x,k). content(k) * f(x)) - y) < e``,
  REWRITE_TAC[has_integral_def, has_integral_compact_interval] THEN
  METIS_TAC[]);

val has_integral_alt = store_thm ("has_integral_alt",
 ``(f has_integral y) i <=>
        if ?a b. i = interval[a,b] then (f has_integral y) i
        else !e. &0 < e
                 ==> ?B. &0 < B /\
                         !a b. ball(0,B) SUBSET interval[a,b]
                               ==> ?z. ((\x. if x IN i then f(x) else 0)
                                        has_integral z) (interval[a,b]) /\
                                       abs(z - y) < e``,
  REPEAT GEN_TAC THEN GEN_REWR_TAC LAND_CONV [has_integral_def] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
   [POP_ASSUM(REPEAT_TCL CHOOSE_THEN SUBST1_TAC), ALL_TAC] THEN
  REWRITE_TAC[has_integral_compact_interval, has_integral]);

val integrable_on = new_definition ("integrable_on",
 ``f integrable_on i <=> ?y. (f has_integral y) i``);

(* renamed `integral` to `HK_integral` (Henstock-Kurzweil integral)
   to prevent naming conflicts with lebesgueTheory. -- Chun Tian
 *)
Definition integral :
    HK_integral i f = @y. (f has_integral y) i
End

val _ = overload_on ("integral", ``HK_integral``);

val INTEGRABLE_INTEGRAL = store_thm ("INTEGRABLE_INTEGRAL",
 ``!f i. f integrable_on i ==> (f has_integral (integral i f)) i``,
  REPEAT GEN_TAC THEN REWRITE_TAC[integrable_on, integral] THEN
  CONV_TAC(RAND_CONV SELECT_CONV) THEN REWRITE_TAC[]);

val HAS_INTEGRAL_INTEGRABLE = store_thm ("HAS_INTEGRAL_INTEGRABLE",
 ``!f i s. (f has_integral i) s ==> f integrable_on s``,
  REWRITE_TAC[integrable_on] THEN MESON_TAC[]);

val HAS_INTEGRAL_INTEGRAL = store_thm ("HAS_INTEGRAL_INTEGRAL",
 ``!f s. f integrable_on s <=> (f has_integral (integral s f)) s``,
  MESON_TAC[INTEGRABLE_INTEGRAL, HAS_INTEGRAL_INTEGRABLE]);

val SUM_CONTENT_NULL = store_thm ("SUM_CONTENT_NULL",
 ``!f:real->real a b p.
        (content (interval[a,b]) = &0) /\
        (p tagged_division_of interval[a,b])
        ==> (sum p (\(x,k). content k * f x) = &0)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_0 THEN
  SIMP_TAC std_ss [FORALL_PROD] THEN
  MAP_EVERY X_GEN_TAC [``p:real``, ``k:real->bool``] THEN
  DISCH_TAC THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN
  UNDISCH_TAC ``(p :real # (real -> bool) -> bool) tagged_division_of
          interval [(a,b)]`` THEN REWRITE_TAC [TAGGED_DIVISION_OF] THEN
  DISCH_THEN(MP_TAC o CONJUNCT1 o CONJUNCT2) THEN
  DISCH_THEN(MP_TAC o SPECL [``p:real``, ``k:real->bool``]) THEN
  ASM_MESON_TAC[CONTENT_SUBSET, CONTENT_POS_LE, REAL_ARITH
   ``&0 <= x /\ x <= y /\ (y = &0) ==> (x:real = &0)``]);

(* ------------------------------------------------------------------------- *)
(* Some basic combining lemmas.                                              *)
(* ------------------------------------------------------------------------- *)

val TAGGED_DIVISION_BIGUNION_EXISTS = store_thm ("TAGGED_DIVISION_BIGUNION_EXISTS",
 ``!d iset i:real->bool.
        FINITE iset /\
        (!i. i IN iset ==> ?p. p tagged_division_of i /\ d FINE p) /\
        (!i1 i2. i1 IN iset /\ i2 IN iset /\ ~(i1 = i2)
                 ==> (interior(i1) INTER interior(i2) = {})) /\
        (BIGUNION iset = i)
        ==> ?p. p tagged_division_of i /\ d FINE p``,
  REPEAT GEN_TAC THEN
  KNOW_TAC ``(!i. i IN iset ==> ?p. p tagged_division_of i /\ d FINE p) =
             (!i. ?p. i IN iset ==> p tagged_division_of i /\ d FINE p)`` THENL
  [SIMP_TAC std_ss [RIGHT_EXISTS_IMP_THM], ALL_TAC] THEN DISC_RW_KILL THEN
  SIMP_TAC std_ss [SKOLEM_THM, LEFT_EXISTS_AND_THM, GSYM LEFT_EXISTS_IMP_THM] THEN
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
  EXISTS_TAC ``BIGUNION (IMAGE(f:(real->bool)->((real#(real->bool))->bool))
                      iset)`` THEN
  ASM_SIMP_TAC std_ss [TAGGED_DIVISION_BIGUNION] THEN
  ASM_MESON_TAC[FINE_BIGUNION, IN_IMAGE]);

(* ------------------------------------------------------------------------- *)
(* The set we're concerned with must be closed.                              *)
(* ------------------------------------------------------------------------- *)

val DIVISION_OF_CLOSED = store_thm ("DIVISION_OF_CLOSED",
 ``!s i. s division_of i ==> closed i``,
  REWRITE_TAC[division_of] THEN MESON_TAC[CLOSED_BIGUNION, CLOSED_INTERVAL]);

(* ------------------------------------------------------------------------- *)
(* General bisection principle for intervals; might be useful elsewhere.     *)
(* ------------------------------------------------------------------------- *)

val FINITE_POWERSET = store_thm ("FINITE_POWERSET",
  ``!s. FINITE s ==> FINITE {t | t SUBSET s}``,
  METIS_TAC [FINITE_POW, POW_DEF]);

val lemma1 = Q.prove (
   `!a b:real. ((a + b) / 2 - a) = ((a + b) - (a + a)) / 2`,
  REPEAT GEN_TAC THEN
  KNOW_TAC ``((a + b) / 2 - a) = ((a + b) / 2 - a / 1:real)`` THENL
  [METIS_TAC [REAL_OVER1], ALL_TAC] THEN DISC_RW_KILL THEN
  SIMP_TAC std_ss [REAL_ARITH ``1 <> 0:real /\ 2 <> 0:real``, REAL_SUB_RAT] THEN
  REWRITE_TAC [REAL_MUL_RID] THEN REWRITE_TAC [GSYM REAL_DOUBLE]);

val lemma2 = Q.prove (
   `!a b:real. (b - (a + b) / 2) = ((b + b) - (a + b)) / 2`,
  REPEAT GEN_TAC THEN
  KNOW_TAC ``(b - (a + b) / 2) = (b / 1 - (a + b) / 2:real)`` THENL
  [METIS_TAC [REAL_OVER1], ALL_TAC] THEN DISC_RW_KILL THEN
  SIMP_TAC std_ss [REAL_ARITH ``1 <> 0:real /\ 2 <> 0:real``, REAL_SUB_RAT] THEN
  REWRITE_TAC [REAL_MUL_LID] THEN METIS_TAC[REAL_MUL_SYM, GSYM REAL_DOUBLE]);

val INTERVAL_BISECTION_STEP = store_thm ("INTERVAL_BISECTION_STEP",
 ``!P. P {} /\
       (!s t. P s /\ P t /\ (interior(s) INTER interior(t) = {})
              ==> P(s UNION t))
       ==> !a b:real.
                ~(P(interval[a,b]))
                ==> ?c d. ~(P(interval[c,d])) /\
                          a <= c /\ c <= d /\ d <= b /\
                                  &2 * (d - c) <= b - a``,
  REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN
  ASM_CASES_TAC ``(a:real) <= (b:real)`` THENL
   [ALL_TAC,
    RULE_ASSUM_TAC(REWRITE_RULE[GSYM INTERVAL_NE_EMPTY]) THEN
    ASM_REWRITE_TAC[]] THEN
  SUBGOAL_THEN
   ``!f. FINITE f /\
        (!s:real->bool. s IN f ==> P s) /\
        (!s:real->bool. s IN f ==> ?a b. s = interval[a,b]) /\
        (!s t. s IN f /\ t IN f /\ ~(s = t)
               ==> (interior(s) INTER interior(t) = {}))
        ==> P(BIGUNION f)``
  ASSUME_TAC THENL
   [ONCE_REWRITE_TAC[GSYM AND_IMP_INTRO] THEN GEN_TAC THEN
    KNOW_TAC ``((!s. s IN f ==> P s) /\ (!s. s IN f ==> ?a b. s = interval [(a,b)]) /\
    (!s t. s IN f /\ t IN f /\ s <> t ==>
       (interior s INTER interior t = {})) ==> P (BIGUNION f)) =
               (\f. (!s. s IN f ==> P s) /\ (!s. s IN f ==> ?a b. s = interval [(a,b)]) /\
    (!s t. s IN f /\ t IN f /\ s <> t ==>
       (interior s INTER interior t = {})) ==> P (BIGUNION f)) f`` THENL
   [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
   MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
    ASM_SIMP_TAC std_ss [BIGUNION_EMPTY, BIGUNION_INSERT, NOT_IN_EMPTY, FORALL_IN_INSERT] THEN
    SIMP_TAC std_ss [GSYM RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[AND_IMP_INTRO] THEN
    X_GEN_TAC ``f :(real -> bool) -> bool`` THEN X_GEN_TAC ``x:real->bool`` THEN
    REPEAT GEN_TAC THEN DISCH_THEN(fn th =>
      FIRST_X_ASSUM MATCH_MP_TAC THEN STRIP_ASSUME_TAC th) THEN
    ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REPEAT (POP_ASSUM MP_TAC) THEN SET_TAC[], ALL_TAC] THEN
    MATCH_MP_TAC INTER_INTERIOR_BIGUNION_INTERVALS THEN
    ASM_REWRITE_TAC[OPEN_INTERIOR] THEN REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INSERT] THEN
    ASM_MESON_TAC[], ALL_TAC] THEN
  DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC
   ``{ interval[c,d] |
       ((c:real) = (a:real)) /\ (d = (a + b) / &2) \/
              (c = (a + b) / &2) /\ ((d:real) = (b:real))}``) THEN
  ONCE_REWRITE_TAC[GSYM AND_IMP_INTRO] THEN
  KNOW_TAC ``FINITE {interval [(c,d)] |
        (c = a) /\ (d = (a + b) / 2) \/ (c = (a + b) / 2) /\ (d = b)}`` THENL
  [MATCH_MP_TAC FINITE_SUBSET THEN
   EXISTS_TAC
     ``IMAGE (\s. interval
       [(@f. f = if (1:num) IN s then (a:real) else (a + b) / &2):real,
        (@f. f = if (1:num) IN s then (a + b) / &2 else (b:real))])
         {s | s SUBSET (1:num..1:num)}`` THEN
    CONJ_TAC THENL
     [SIMP_TAC std_ss [FINITE_POWERSET, IMAGE_FINITE, FINITE_NUMSEG], ALL_TAC] THEN
    SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION, IN_IMAGE, EXISTS_PROD] THEN
    X_GEN_TAC ``k:real->bool`` THEN
    DISCH_THEN(X_CHOOSE_THEN ``c:real`` (X_CHOOSE_THEN ``d:real``
      (CONJUNCTS_THEN2 SUBST1_TAC ASSUME_TAC))) THEN
    EXISTS_TAC ``{i | (i = 1:num) /\ ((c:real) = (a:real))}`` THEN
    CONJ_TAC THENL [ALL_TAC, SIMP_TAC std_ss [GSPECIFICATION, IN_NUMSEG]] THEN
    AP_TERM_TAC THEN REWRITE_TAC[CONS_11, PAIR_EQ] THEN
    SIMP_TAC std_ss [GSPECIFICATION] THEN POP_ASSUM MP_TAC THEN
    UNDISCH_TAC ``a <= b:real`` THEN REWRITE_TAC [AND_IMP_INTRO] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
    SIMP_TAC arith_ss [REAL_EQ_RDIV_EQ, REAL_LT] THEN
    REAL_ARITH_TAC, ALL_TAC] THEN
  DISCH_TAC THEN ASM_SIMP_TAC std_ss [] THEN
  GEN_REWR_TAC LAND_CONV [MONO_NOT_EQ] THEN
  KNOW_TAC `` (~(P :(real -> bool) -> bool)
        (BIGUNION {interval [(c,d)] |
            (c = (a :real)) /\ (d = (a + (b :real)) / (2 :real)) \/
            (c = (a + b) / (2 :real)) /\ (d = b)}))`` THENL
   [UNDISCH_TAC ``~(P :(real -> bool) -> bool)(interval[a:real,b])`` THEN
    MATCH_MP_TAC EQ_IMPLIES THEN
    AP_TERM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN
    GEN_REWR_TAC I [EXTENSION] THEN
    SIMP_TAC std_ss [IN_BIGUNION, GSPECIFICATION, EXISTS_PROD] THEN
    ONCE_REWRITE_TAC [CONJ_SYM] THEN X_GEN_TAC ``x:real`` THEN
    SIMP_TAC std_ss [GSYM LEFT_EXISTS_AND_THM] THEN
    ONCE_REWRITE_TAC[CONJ_SYM] THEN
    REWRITE_TAC[UNWIND_THM2, IN_INTERVAL] THEN
    ONCE_REWRITE_TAC[TAUT `c /\ (a \/ b) <=> ~(a ==> ~c) \/ ~(b ==> ~c)`] THEN
    REWRITE_TAC[TAUT `~(a ==> ~b) <=> a /\ b`, GSYM CONJ_ASSOC] THEN
    SIMP_TAC std_ss [EXISTS_OR_THM, RIGHT_EXISTS_AND_THM] THEN
    SIMP_TAC arith_ss [REAL_LE_LDIV_EQ, REAL_LE_RDIV_EQ, REAL_LT] THEN
    REAL_ARITH_TAC, ALL_TAC] THEN
  DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
  KNOW_TAC ``
      (!(s :real -> bool). s IN {interval [(c,d)] |
          (c = a) /\ (d = (a + b) / (2 :real)) \/
          (c = (a + b) / (2 :real)) /\ (d = b)} ==>
         ?(a :real) (b :real). s = interval [(a,b)]) =
     (!c d. (c = a) /\ (d = (a + b) / 2) \/
            (c = (a + b) / 2) /\ (d = b) ==>
       ?a b. interval [(c,d)] = interval [(a,b)])`` THENL
  [SIMP_TAC std_ss [FORALL_IN_GSPEC], ALL_TAC] THEN DISC_RW_KILL THEN
  KNOW_TAC ``(!(s :real -> bool). s IN {interval [(c,d)] |
          (c = (a :real)) /\ (d = (a + (b :real)) / (2 :real)) \/
          (c = (a + b) / (2 :real)) /\ (d = b)} ==>
         (P :(real -> bool) -> bool) s) =
       (!c d. (c = a) /\ (d = (a + b) / 2) \/
              (c = (a + b) / 2) /\ (d = b) ==>
       (P :(real -> bool) -> bool) (interval [(c,d)])) `` THENL
  [SIMP_TAC std_ss [FORALL_IN_GSPEC], ALL_TAC] THEN DISC_RW_KILL THEN
  MATCH_MP_TAC(TAUT `b /\ (~a ==> e) /\ c ==> ~(a /\ b /\ c) ==> e`) THEN
  CONJ_TAC THENL [MESON_TAC[], ALL_TAC] THEN CONJ_TAC THENL
   [SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP] THEN
    DISCH_THEN (X_CHOOSE_TAC ``c:real``) THEN EXISTS_TAC ``c:real`` THEN
    POP_ASSUM MP_TAC THEN DISCH_THEN (X_CHOOSE_TAC ``d:real``) THEN
    EXISTS_TAC ``d:real`` THEN POP_ASSUM MP_TAC THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN
    ASSUME_TAC REAL_MIDDLE1 THEN ASSUME_TAC REAL_MIDDLE2 THEN
    RW_TAC std_ss [] THENL [REAL_ARITH_TAC, METIS_TAC [], METIS_TAC [],
    ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN SIMP_TAC std_ss [lemma1,
    REAL_DIV_RMUL, REAL_ARITH ``2 <> 0:real``] THEN REAL_ARITH_TAC,
    METIS_TAC [], METIS_TAC [], REAL_ARITH_TAC, ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN
    SIMP_TAC std_ss [lemma2, REAL_DIV_RMUL, REAL_ARITH ``2 <> 0:real``] THEN
    REAL_ARITH_TAC], ALL_TAC] THEN
  SIMP_TAC std_ss [GSYM AND_IMP_INTRO, RIGHT_FORALL_IMP_THM, FORALL_IN_GSPEC] THEN
  REWRITE_TAC[AND_IMP_INTRO, INTERIOR_CLOSED_INTERVAL] THEN
  SIMP_TAC std_ss [GSYM RIGHT_FORALL_IMP_THM] THEN
  MAP_EVERY X_GEN_TAC
   [``c1:real``, ``d1:real``, ``c2:real``, ``d2:real``] THEN
  ASM_CASES_TAC ``(c1 = c2:real) /\ (d1 = d2:real)`` THENL
   [ASM_REWRITE_TAC[], ALL_TAC] THEN
  DISCH_THEN(fn th =>
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (K ALL_TAC)) THEN MP_TAC th) THEN
  REWRITE_TAC[AND_IMP_INTRO] THEN
  UNDISCH_TAC ``~((c1 = c2:real) /\ (d1 = d2:real))`` THEN
  ASM_REWRITE_TAC[AND_IMP_INTRO] THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
  ASM_REWRITE_TAC[EXTENSION, IN_INTERVAL, NOT_IN_EMPTY, IN_INTER] THEN
  SIMP_TAC arith_ss [REAL_EQ_RDIV_EQ, REAL_EQ_LDIV_EQ, REAL_LT] THEN
  REWRITE_TAC[
    REAL_ARITH ``((a * &2 <> a + b) \/ (a + b <> b * &2)) <=> ~(a = b:real)``,
    REAL_ARITH ``((a + b <> a * &2) \/ (b * &2 <> a + b)) <=> ~(a = b:real)``] THEN
  DISCH_THEN(fn th => X_GEN_TAC ``x:real`` THEN MP_TAC th) THEN
  REAL_ARITH_TAC);

val lemma1 = Q.prove (`!n. 2 pow n <> 0:real`,
  GEN_TAC THEN ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN
  MATCH_MP_TAC REAL_LT_IMP_NE THEN MATCH_MP_TAC REAL_LET_TRANS THEN
  EXISTS_TAC ``&n:real`` THEN SIMP_TAC std_ss [REAL_POS, POW_2_LT]);

val INTERVAL_BISECTION = store_thm ("INTERVAL_BISECTION",
 ``!P. P {} /\
       (!s t. P s /\ P t /\ (interior(s) INTER interior(t) = {})
              ==> P(s UNION t))
       ==> !a b:real.
                ~(P(interval[a,b]))
                ==> ?x. x IN interval[a,b] /\
                        !e. &0 < e
                            ==> ?c d. x IN interval[c,d] /\
                                      interval[c,d] SUBSET ball(x,e) /\
                                      interval[c,d] SUBSET interval[a,b] /\
                                      ~P(interval[c,d])``,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   ``?A B. (A(0) = a:real) /\ (B(0) = b) /\
          !n. ~(P(interval[A(SUC n), B(SUC n)])) /\
            A(n) <= A(SUC n) /\ A(SUC n) <= B(SUC n) /\
            B(SUC n) <= B(n) /\
            &2 * (B(SUC n) - A(SUC n)) <= B(n) - A(n)``
  STRIP_ASSUME_TAC THENL
   [MP_TAC(ISPEC ``P:(real->bool)->bool`` INTERVAL_BISECTION_STEP) THEN
    ASM_REWRITE_TAC[] THEN
  KNOW_TAC ``((!a b. ~P (interval [(a,b)]) ==>
       ?c d. ~P (interval [(c,d)]) /\ a <= c /\ c <= d /\ d <= b /\
                            2 * (d - c) <= b - a)) =
           ((!a b. ?c d. ~P (interval [(a,b)]) ==>
             ~P (interval [(c,d)]) /\ a <= c /\ c <= d /\ d <= b /\
                            2 * (d - c) <= b - a))`` THENL
    [SIMP_TAC std_ss [GSYM RIGHT_EXISTS_IMP_THM], ALL_TAC] THEN
    DISC_RW_KILL THEN SIMP_TAC std_ss [SKOLEM_THM] THEN
    DISCH_THEN(X_CHOOSE_THEN ``C:real->real->real``
     (X_CHOOSE_THEN ``D:real->real->real`` ASSUME_TAC)) THEN
    KNOW_TAC ``?E. ((E (0:num) = (a:real,b:real)) /\
                (!n. E(SUC n) = (C (FST(E n)) (SND(E n)),
                                 D (FST(E n)) (SND(E n)))))`` THENL
    [RW_TAC real_ss [num_Axiom], ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN ``E:num->real#real`` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC ``\n. FST((E:num->real#real) n)`` THEN
    EXISTS_TAC ``\n. SND((E:num->real#real) n)`` THEN BETA_TAC THEN
    ASM_REWRITE_TAC[] THEN INDUCT_TAC THEN ASM_SIMP_TAC std_ss [],
    ALL_TAC] THEN
  SUBGOAL_THEN ``!e. &0 < e
        ==> ?n:num. !x y. x IN interval[A(n),B(n)] /\ y IN interval[A(n),B(n)]
                          ==> dist(x,y:real) < e`` ASSUME_TAC THENL
   [X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN MP_TAC(SPEC
     ``sum(1:num..1:num) (\i. (b:real) - (a:real)) / e``
     REAL_ARCH_POW2) THEN STRIP_TAC THEN EXISTS_TAC ``n:num`` THEN
    MAP_EVERY X_GEN_TAC [``x:real``, ``y:real``] THEN STRIP_TAC THEN
    MATCH_MP_TAC REAL_LET_TRANS THEN
    EXISTS_TAC ``sum(1:num..1:num)(\i. abs((x - y:real)))`` THEN
    CONJ_TAC THENL [REWRITE_TAC [NUMSEG_SING, SUM_SING, REAL_LE_REFL, dist] THEN
     REAL_ARITH_TAC, ALL_TAC] THEN
    MATCH_MP_TAC REAL_LET_TRANS THEN
    EXISTS_TAC ``sum(1:num..1:num)
                   (\i. (B:num->real)(n) - (A:num->real)(n))`` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC SUM_LE_NUMSEG THEN REPEAT STRIP_TAC THEN BETA_TAC THEN
      MATCH_MP_TAC(REAL_ARITH ``a <= x /\ x <= b /\ a <= y /\ y <= b
                               ==> abs(x - y) <= b - a:real``) THEN
      UNDISCH_TAC ``x IN interval[(A:num->real) n,B n]`` THEN
      UNDISCH_TAC ``y IN interval[(A:num->real) n,B n]`` THEN
      REWRITE_TAC[IN_INTERVAL] THEN ASM_SIMP_TAC std_ss [],
      ALL_TAC] THEN
    MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC
     ``sum(1:num..1:num) (\i. (b:real) - (a:real)) / (2:real) pow n`` THEN
    CONJ_TAC THENL
     [ALL_TAC,
      SIMP_TAC arith_ss [REAL_LT_LDIV_EQ, REAL_POW_LT, REAL_LT] THEN
      ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
      ASM_SIMP_TAC std_ss [GSYM REAL_LT_LDIV_EQ]] THEN
    REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
    REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN
    X_GEN_TAC ``j:num`` THEN STRIP_TAC THEN REWRITE_TAC[] THEN
    ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN
    SPEC_TAC(``n:num``,``m:num``) THEN INDUCT_TAC THEN
    ASM_REWRITE_TAC[pow, REAL_OVER1, REAL_LE_REFL] THEN
    ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
    SIMP_TAC arith_ss [real_div, REAL_INV_MUL, REAL_MUL_ASSOC, lemma1,
                       REAL_ARITH ``2 <> 0:real``] THEN
    SIMP_TAC arith_ss [GSYM real_div, REAL_LE_RDIV_EQ, REAL_LT] THEN
    ASM_MESON_TAC[REAL_LE_TRANS, REAL_MUL_SYM], ALL_TAC] THEN
  SUBGOAL_THEN ``?a:real. !n:num. a IN interval[A(n),B(n)]`` MP_TAC THENL
   [ONCE_REWRITE_TAC [METIS [] ``!a n. interval [(A n,B n)] =
                                  (\n. interval [(A n,B n)]) n``] THEN
    MATCH_MP_TAC DECREASING_CLOSED_NEST THEN
    ASM_SIMP_TAC std_ss [CLOSED_INTERVAL] THEN CONJ_TAC THENL
     [REWRITE_TAC[GSYM INTERVAL_EQ_EMPTY] THEN
      METIS_TAC[REAL_NOT_LT, REAL_LE_TRANS],
      ALL_TAC] THEN
    REWRITE_TAC[LE_EXISTS] THEN SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC ``m:num`` THEN
    SIMP_TAC std_ss [GSYM LEFT_IMP_EXISTS_THM, EXISTS_REFL] THEN
    INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES, SUBSET_REFL] THEN
    MATCH_MP_TAC SUBSET_TRANS THEN
    EXISTS_TAC ``interval[A(m + d:num):real,B(m + d)]`` THEN
    ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[SUBSET_DEF, IN_INTERVAL] THEN ASM_MESON_TAC[REAL_LE_TRANS],
    ALL_TAC] THEN
  DISCH_THEN (X_CHOOSE_TAC ``x0:real``) THEN EXISTS_TAC ``x0:real`` THEN
  CONJ_TAC THENL [ASM_MESON_TAC[], ALL_TAC] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``e:real``) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_TAC ``n:num``) THEN
  MAP_EVERY EXISTS_TAC [``(A:num->real) n``, ``(B:num->real) n``] THEN
  ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
   [REWRITE_TAC[SUBSET_DEF, IN_BALL] THEN ASM_MESON_TAC[],
    ALL_TAC,
    SPEC_TAC(``n:num``,``p:num``) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[]] THEN
  SUBGOAL_THEN
   ``!m n. m <= n ==> interval[(A:num->real) n,B n] SUBSET interval[A m,B m]``
    (fn th => ASM_MESON_TAC[SUBSET_DEF, LE_0, th]) THEN
  ONCE_REWRITE_TAC [METIS [] ``!m n. (interval [(A n,B n)] SUBSET
                                      interval [(A m,B m)]) =
                               (\m n. interval [(A n,B n)] SUBSET
                                      interval [(A m,B m)]) m n``] THEN
  MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
  REPEAT(CONJ_TAC THENL [SET_TAC[], ALL_TAC]) THEN
  REWRITE_TAC[SUBSET_INTERVAL] THEN ASM_MESON_TAC[]);

(* ------------------------------------------------------------------------- *)
(* Cousin's lemma.                                                           *)
(* ------------------------------------------------------------------------- *)

val FINE_DIVISION_EXISTS = store_thm ("FINE_DIVISION_EXISTS",
 ``!g a b:real.
        gauge g ==> ?p. p tagged_division_of (interval[a,b]) /\ g FINE p``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC ``\s:real->bool. ?p. p tagged_division_of s /\ g FINE p``
        INTERVAL_BISECTION) THEN
  SIMP_TAC std_ss [] THEN
  KNOW_TAC ``(?p. p tagged_division_of {} /\ g FINE p) /\
 (!s t.
    (?p. p tagged_division_of s /\ g FINE p) /\
    (?p. p tagged_division_of t /\ g FINE p) /\
    (interior s INTER interior t = {}) ==>
    ?p. p tagged_division_of s UNION t /\ g FINE p)`` THENL
   [MESON_TAC[TAGGED_DIVISION_UNION, FINE_UNION,
              TAGGED_DIVISION_OF_EMPTY, FINE, NOT_IN_EMPTY],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
    DISCH_THEN(MP_TAC o SPECL [``a:real``, ``b:real``])] THEN
  GEN_REWR_TAC LAND_CONV [MONO_NOT_EQ] THEN
  REWRITE_TAC [GSYM DE_MORGAN_THM] THEN
  REWRITE_TAC [METIS [] ``( ~!p. ~(p tagged_division_of interval [(a,b)] /\ g FINE p)) =
                          ( ?p. (p tagged_division_of interval [(a,b)] /\ g FINE p))``] THEN
  DISCH_THEN MATCH_MP_TAC THEN
  DISCH_THEN(X_CHOOSE_THEN ``x:real`` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  FIRST_ASSUM(MP_TAC o SPEC ``x:real`` o REWRITE_RULE[gauge_def]) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  SIMP_TAC std_ss [OPEN_CONTAINS_BALL, NOT_FORALL_THM] THEN
  DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
  STRIP_TAC THEN EXISTS_TAC ``e:real`` THEN
  ASM_SIMP_TAC std_ss [NOT_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [``c:real``, ``d:real``] THEN
  CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``{(x:real,interval[c:real,d])}``) THEN
  ASM_SIMP_TAC std_ss [TAGGED_DIVISION_OF_SELF] THEN
  SIMP_TAC std_ss [FINE, IN_SING, PAIR_EQ] THEN ASM_MESON_TAC[SUBSET_TRANS]);

(* ------------------------------------------------------------------------- *)
(* Basic theorems about integrals.                                           *)
(* ------------------------------------------------------------------------- *)

val HAS_INTEGRAL_UNIQUE = store_thm ("HAS_INTEGRAL_UNIQUE",
 ``!f:real->real i k1 k2.
        (f has_integral k1) i /\ (f has_integral k2) i ==> (k1 = k2)``,
  REPEAT GEN_TAC THEN
  SUBGOAL_THEN
   ``!f:real->real a b k1 k2.
       (f has_integral k1) (interval[a,b]) /\
       (f has_integral k2) (interval[a,b])
       ==> (k1 = k2)``
  MP_TAC THENL
   [REPEAT GEN_TAC THEN REWRITE_TAC[has_integral] THEN
    SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN
    REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN
    ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
    ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
    REWRITE_TAC[REAL_ARITH ``!x. ~(x:real = &0) <=> &0 < abs x``] THEN DISCH_TAC THEN
    DISCH_THEN(MP_TAC o SPEC ``abs(k1 - k2 :real) / &2``) THEN
    ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
    DISCH_THEN(CONJUNCTS_THEN2
     (X_CHOOSE_THEN ``d1:real->real->bool`` STRIP_ASSUME_TAC)
     (X_CHOOSE_THEN ``d2:real->real->bool`` STRIP_ASSUME_TAC)) THEN
    MP_TAC(ISPEC ``\x. ((d1:real->real->bool) x) INTER (d2 x)``
                 FINE_DIVISION_EXISTS) THEN
    DISCH_THEN(MP_TAC o SPECL [``a:real``, ``b:real``]) THEN
    ASM_SIMP_TAC std_ss [GAUGE_INTER] THEN
    KNOW_TAC ``(?p. p tagged_division_of interval [a,b] /\
               (\x. d1 x INTER d2 x) FINE p) ==> F`` THENL
    [ALL_TAC,METIS_TAC []] THEN POP_ASSUM MP_TAC THEN
    UNDISCH_TAC `` !p.
        p tagged_division_of interval [(a,b)] /\ d1 FINE p ==>
        abs (sum p (\(x,k). content k * f x) - k1) < abs (k1 - k2) / 2`` THEN
    REWRITE_TAC [] THEN SIMP_TAC std_ss [AND_IMP_INTRO, NOT_EXISTS_THM] THEN
    SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN DISCH_TAC THEN
    GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `(p :real # (real -> bool) -> bool)`) THEN
    REWRITE_TAC [GSYM DE_MORGAN_THM] THEN
    MATCH_MP_TAC(TAUT
     `(f0 ==> f1 /\ f2) /\ ~(n1 /\ n2)
      ==> (t /\ f1 ==> n1) /\ (t /\ f2 ==> n2) ==> ~(t /\ f0)`) THEN
    CONJ_TAC THENL [SIMP_TAC std_ss [FINE, SUBSET_INTER], ALL_TAC] THEN
    MATCH_MP_TAC(METIS [REAL_HALF, REAL_LT_ADD2, REAL_NOT_LE]
      ``c:real <= a + b ==> ~(a < c / &2 /\ b < c / &2)``) THEN
    MESON_TAC[ABS_SUB, ABS_TRIANGLE, REAL_ARITH
     ``k1 - k2:real = (k1 - x) + (x - k2)``],
    ALL_TAC] THEN
  DISCH_TAC THEN ONCE_REWRITE_TAC[has_integral_alt] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
   [ASM_MESON_TAC[], ALL_TAC] THEN
  DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH
   ``~(&0:real < abs(x - y)) ==> (x = y)``) THEN
  DISCH_TAC THEN
  FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC ``abs(k1 - k2:real) / &2``)) THEN
  ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN ``B1:real`` STRIP_ASSUME_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN ``B2:real`` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPEC
   ``ball(0,B1) UNION ball(0:real,B2)``
   BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
  SIMP_TAC std_ss [BOUNDED_UNION, BOUNDED_BALL, UNION_SUBSET, NOT_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN
  REWRITE_TAC [GSYM DE_MORGAN_THM] THEN
  DISCH_THEN(CONJUNCTS_THEN(ANTE_RES_THEN MP_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN ``w:real`` STRIP_ASSUME_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN ``z:real`` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN ``w:real = z:real`` SUBST_ALL_TAC THENL
  [METIS_TAC [], ALL_TAC] THEN
  KNOW_TAC ``~(abs(z - k1) < abs(k1 - k2) / &2:real /\
               abs(z - k2) < abs(k1 - k2) / &2:real)`` THENL
  [SIMP_TAC arith_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
   REWRITE_TAC [GSYM REAL_DOUBLE] THEN REAL_ARITH_TAC, ALL_TAC] THEN
  METIS_TAC[]);

val INTEGRAL_UNIQUE = store_thm ("INTEGRAL_UNIQUE",
 ``!f y k.
      (f has_integral y) k ==> (integral k f = y)``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[integral] THEN
  MATCH_MP_TAC SELECT_UNIQUE THEN ASM_MESON_TAC[HAS_INTEGRAL_UNIQUE]);;

val HAS_INTEGRAL_INTEGRABLE_INTEGRAL = store_thm ("HAS_INTEGRAL_INTEGRABLE_INTEGRAL",
 ``!f:real->real i s.
        (f has_integral i) s <=> f integrable_on s /\ (integral s f = i)``,
  MESON_TAC[INTEGRABLE_INTEGRAL, INTEGRAL_UNIQUE, integrable_on]);

val INTEGRAL_EQ_HAS_INTEGRAL = store_thm ("INTEGRAL_EQ_HAS_INTEGRAL",
 ``!s f y. f integrable_on s ==> ((integral s f = y) <=> (f has_integral y) s)``,
  MESON_TAC[INTEGRABLE_INTEGRAL, INTEGRAL_UNIQUE]);

val HAS_INTEGRAL_IS_0 = store_thm ("HAS_INTEGRAL_IS_0",
 ``!f:real->real s.
        (!x. x IN s ==> (f(x) = 0)) ==> (f has_integral 0) s``,
  SUBGOAL_THEN
   ``!f:real->real a b.
        (!x. x IN interval[a,b] ==> (f(x) = 0))
        ==> (f has_integral 0) (interval[a,b])``
  ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN REWRITE_TAC[has_integral] THEN
    REPEAT STRIP_TAC THEN EXISTS_TAC ``\x:real. ball(x,&1)`` THEN
    SIMP_TAC std_ss [gauge_def, OPEN_BALL, CENTRE_IN_BALL, REAL_LT_01] THEN
    REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
    UNDISCH_TAC ``&0 < e:real`` THEN MATCH_MP_TAC(TAUT `(a <=> b) ==> b ==> a`) THEN
    AP_THM_TAC THEN AP_TERM_TAC THEN
    REWRITE_TAC[ABS_ZERO, REAL_SUB_0, REAL_ADD_LID] THEN
    MATCH_MP_TAC SUM_EQ_0 THEN SIMP_TAC std_ss [FORALL_PROD] THEN
    X_GEN_TAC ``x:real`` THEN REPEAT STRIP_TAC THEN
    SUBGOAL_THEN ``(x:real) IN interval[a,b]``
     (fn th => ASM_SIMP_TAC std_ss [th, REAL_MUL_RZERO]) THEN
    UNDISCH_TAC ``p tagged_division_of interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [tagged_division_of]) THEN
    REWRITE_TAC[tagged_partial_division_of, SUBSET_DEF] THEN ASM_MESON_TAC[],
    ALL_TAC] THEN
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[has_integral_alt] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
   [ASM_MESON_TAC[], ALL_TAC] THEN
  GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC ``&1:real`` THEN REWRITE_TAC[REAL_LT_01] THEN
  REPEAT STRIP_TAC THEN EXISTS_TAC ``0:real`` THEN
  ASM_REWRITE_TAC[REAL_SUB_REFL, ABS_0] THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN METIS_TAC[]);

val HAS_INTEGRAL_0 = store_thm ("HAS_INTEGRAL_0",
 ``!s. ((\x. 0) has_integral 0) s``,
  SIMP_TAC std_ss [HAS_INTEGRAL_IS_0]);

val HAS_INTEGRAL_0_EQ = store_thm ("HAS_INTEGRAL_0_EQ",
 ``!i s. ((\x. 0) has_integral i) s <=> (i = 0)``,
  MESON_TAC[HAS_INTEGRAL_UNIQUE, HAS_INTEGRAL_0]);

val HAS_INTEGRAL_LINEAR = store_thm ("HAS_INTEGRAL_LINEAR",
 ``!f:real->real y s h:real->real.
        (f has_integral y) s /\ linear h ==> ((h o f) has_integral h(y)) s``,
  SUBGOAL_THEN
    ``!f:real->real y a b h:real->real.
          (f has_integral y) (interval[a,b]) /\ linear h
          ==> ((h o f) has_integral h(y)) (interval[a,b])``
  MP_TAC THENL
   [REPEAT GEN_TAC THEN REWRITE_TAC[has_integral] THEN STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN
    DISCH_THEN(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC) THEN
    X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
    UNDISCH_TAC ``!e.
        0 < e ==> ?d. gauge d /\
          !p. p tagged_division_of interval [(a,b)] /\ d FINE p ==>
            abs (sum p (\(x,k). content k * f x) - y) < e`` THEN
    DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``e:real / B``) THEN
    ASM_SIMP_TAC std_ss [REAL_LT_DIV] THEN
    STRIP_TAC THEN EXISTS_TAC ``d:real -> real -> bool`` THEN
    ASM_SIMP_TAC std_ss [] THEN
    X_GEN_TAC ``p:real#(real->bool)->bool`` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``p:real#(real->bool)->bool``) THEN
    ASM_SIMP_TAC std_ss [REAL_LT_RDIV_EQ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
    MATCH_MP_TAC(REAL_ARITH ``x <= y ==> y < e ==> x < e:real``) THEN
    FIRST_ASSUM(fn th => W(fn (asl,w) =>
      MP_TAC(PART_MATCH rand th (rand w)))) THEN
    MATCH_MP_TAC(REAL_ARITH ``x <= y ==> y <= e ==> x <= e:real``) THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
    ASM_SIMP_TAC std_ss [LINEAR_SUB, LINEAR_SUM, o_DEF, LAMBDA_PROD,
                 REAL_MUL_SYM, LINEAR_CMUL, REAL_LE_REFL], ALL_TAC] THEN
  DISCH_TAC THEN REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  ONCE_REWRITE_TAC[has_integral_alt] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
   [ASM_MESON_TAC[], ALL_TAC] THEN
  DISCH_TAC THEN
  FIRST_ASSUM(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC o MATCH_MP
    LINEAR_BOUNDED_POS) THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  UNDISCH_TAC ``!e.
        0 < e ==> ?B. 0 < B /\
          !a b. ball (0,B) SUBSET interval [(a,b)] ==>
            ?z. ((\x. if x IN s then f x else 0) has_integral z)
                (interval [(a,b)]) /\ abs (z - y) < e`` THEN
  DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``e / B:real``) THEN
  ASM_SIMP_TAC std_ss [REAL_LT_DIV] THEN
  DISCH_THEN (X_CHOOSE_TAC ``M:real``) THEN
  EXISTS_TAC ``M:real`` THEN POP_ASSUM MP_TAC THEN
  MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
  DISCH_TAC THEN MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN
  POP_ASSUM (MP_TAC o Q.SPECL [`a:real`, `b:real`]) THEN
  MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN ``z:real`` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC ``(h:real->real) z`` THEN
  SUBGOAL_THEN
   ``(\x. if x IN s then (h:real->real) ((f:real->real) x) else 0)
    = h o (\x. if x IN s then f x else 0)``
  SUBST1_TAC THENL
   [SIMP_TAC std_ss [FUN_EQ_THM, o_THM] THEN METIS_TAC[LINEAR_0], ALL_TAC] THEN
  ASM_SIMP_TAC std_ss [GSYM LINEAR_SUB] THEN
  MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ``B * abs(z - y:real)`` THEN
  ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
  ASM_SIMP_TAC std_ss [GSYM REAL_LT_RDIV_EQ]);

val HAS_INTEGRAL_CMUL = store_thm ("HAS_INTEGRAL_CMUL",
 ``!(f:real->real) k s c.
        (f has_integral k) s
        ==> ((\x. c * f(x)) has_integral (c * k)) s``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC
   (REWRITE_RULE[o_DEF] HAS_INTEGRAL_LINEAR) THEN
  ASM_REWRITE_TAC[linear] THEN CONJ_TAC THEN REAL_ARITH_TAC);

val HAS_INTEGRAL_NEG = store_thm ("HAS_INTEGRAL_NEG",
 ``!f k s. (f has_integral k) s ==> ((\x. -(f x)) has_integral (-k)) s``,
  ONCE_REWRITE_TAC[REAL_NEG_MINUS1] THEN REWRITE_TAC[HAS_INTEGRAL_CMUL]);

val HAS_INTEGRAL_ADD = store_thm ("HAS_INTEGRAL_ADD",
 ``!f:real->real g s k.
        (f has_integral k) s /\ (g has_integral l) s
        ==> ((\x. f(x) + g(x)) has_integral (k + l)) s``,
  SUBGOAL_THEN
   ``!f:real->real g k l a b.
        (f has_integral k) (interval[a,b]) /\
        (g has_integral l) (interval[a,b])
        ==> ((\x. f(x) + g(x)) has_integral (k + l)) (interval[a,b])``
  ASSUME_TAC THENL
   [REPEAT GEN_TAC THEN SIMP_TAC std_ss [has_integral, GSYM FORALL_AND_THM] THEN
    DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
    DISCH_THEN(CONJUNCTS_THEN2
     (X_CHOOSE_THEN ``d1:real->real->bool`` STRIP_ASSUME_TAC)
     (X_CHOOSE_THEN ``d2:real->real->bool`` STRIP_ASSUME_TAC)) THEN
    EXISTS_TAC ``\x. ((d1:real->real->bool) x) INTER (d2 x)`` THEN
    ASM_SIMP_TAC std_ss [GAUGE_INTER] THEN
    REWRITE_TAC[tagged_division_of, tagged_partial_division_of] THEN
    SIMP_TAC std_ss [SUM_ADD, REAL_ADD_LDISTRIB, LAMBDA_PAIR] THEN
    SIMP_TAC std_ss [GSYM LAMBDA_PAIR] THEN
    REWRITE_TAC [METIS [] ``(a <> b) = ~(a = b)``, GSYM DE_MORGAN_THM] THEN
    REWRITE_TAC [GSYM PAIR_EQ] THEN
    SIMP_TAC std_ss [GSYM tagged_partial_division_of] THEN
    REWRITE_TAC[GSYM tagged_division_of, FINE_INTER] THEN
    SIMP_TAC std_ss [REAL_ARITH ``(a + b) - (c + d) = (a - c) + (b - d):real``] THEN
    REPEAT STRIP_TAC THEN MATCH_MP_TAC ABS_TRIANGLE_LT THEN
    MATCH_MP_TAC(METIS [REAL_HALF, REAL_LT_ADD2]
     ``x < e / &2 /\ y < e / &2 ==> x + y < e:real``) THEN
    ASM_SIMP_TAC std_ss [], ALL_TAC] THEN
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[has_integral_alt] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
   [METIS_TAC[], ALL_TAC] THEN
  DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC ``e / &2:real``)) THEN
  ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN ``B1:real`` STRIP_ASSUME_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN ``B2:real`` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC ``max B1 B2:real`` THEN ASM_REWRITE_TAC[REAL_LT_MAX] THEN
  REWRITE_TAC[BALL_MAX_UNION, UNION_SUBSET] THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN
  DISCH_THEN(CONJUNCTS_THEN(ANTE_RES_THEN MP_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN ``w:real`` STRIP_ASSUME_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN ``z:real`` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC ``w + z:real`` THEN BETA_TAC THEN
  SUBGOAL_THEN
    ``(\x. if x IN s then (f:real->real) x + g x else 0) =
      (\x. (if x IN s then f x else 0) + (if x IN s then g x else 0))``
  SUBST1_TAC THENL
   [SIMP_TAC std_ss [FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN
    ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC,
    ALL_TAC] THEN
  ASM_SIMP_TAC std_ss [] THEN
  REWRITE_TAC [REAL_ARITH ``(w + z - (k + l)) = ((w - k) + (z - l):real)``] THEN
  METIS_TAC [ABS_TRIANGLE_LT, REAL_HALF, REAL_LT_ADD2]);

val HAS_INTEGRAL_SUB = store_thm ("HAS_INTEGRAL_SUB",
 ``!f:real->real g s k l.
        (f has_integral k) s /\ (g has_integral l) s
        ==> ((\x. f(x) - g(x)) has_integral (k - l)) s``,
  SIMP_TAC std_ss [real_sub, HAS_INTEGRAL_NEG, HAS_INTEGRAL_ADD]);

val INTEGRAL_0 = store_thm ("INTEGRAL_0",
 ``!s. integral s (\x. 0) = 0``,
  MESON_TAC[INTEGRAL_UNIQUE, HAS_INTEGRAL_0]);

val INTEGRAL_ADD = store_thm ("INTEGRAL_ADD",
 ``!f:real->real g s.
        f integrable_on s /\ g integrable_on s
        ==> (integral s (\x. f x + g x) = integral s f + integral s g)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN
  MATCH_MP_TAC HAS_INTEGRAL_ADD THEN ASM_SIMP_TAC std_ss [INTEGRABLE_INTEGRAL]);

val INTEGRAL_CMUL = store_thm ("INTEGRAL_CMUL",
 ``!f:real->real c s.
        f integrable_on s ==> (integral s (\x. c * f(x)) = c * integral s f)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN
  MATCH_MP_TAC HAS_INTEGRAL_CMUL THEN ASM_SIMP_TAC std_ss [INTEGRABLE_INTEGRAL]);

val INTEGRAL_NEG = store_thm ("INTEGRAL_NEG",
 ``!f:real->real s.
        f integrable_on s ==> (integral s (\x. -f(x)) = -integral s f)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN
  MATCH_MP_TAC HAS_INTEGRAL_NEG THEN ASM_SIMP_TAC std_ss [INTEGRABLE_INTEGRAL]);

val INTEGRAL_SUB = store_thm ("INTEGRAL_SUB",
 ``!f:real->real g k l s.
        f integrable_on s /\ g integrable_on s
        ==> (integral s (\x. f x - g x) = integral s f - integral s g)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN
  MATCH_MP_TAC HAS_INTEGRAL_SUB THEN ASM_SIMP_TAC std_ss [INTEGRABLE_INTEGRAL]);

val INTEGRABLE_0 = store_thm ("INTEGRABLE_0",
 ``!s. (\x. 0) integrable_on s``,
  REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_0]);

val INTEGRABLE_ADD = store_thm ("INTEGRABLE_ADD",
 ``!f:real->real g s.
        f integrable_on s /\ g integrable_on s
        ==> (\x. f x + g x) integrable_on s``,
  REWRITE_TAC[integrable_on] THEN METIS_TAC[HAS_INTEGRAL_ADD]);

val INTEGRABLE_CMUL = store_thm ("INTEGRABLE_CMUL",
 ``!f:real->real c s.
        f integrable_on s ==> (\x. c * f(x)) integrable_on s``,
  REWRITE_TAC[integrable_on] THEN METIS_TAC[HAS_INTEGRAL_CMUL]);

val INTEGRABLE_CMUL_EQ = store_thm ("INTEGRABLE_CMUL_EQ",
 ``!f:real->real s c.
      (\x. c * f x) integrable_on s <=> (c = &0) \/ f integrable_on s``,
  REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN
  ASM_SIMP_TAC std_ss [INTEGRABLE_CMUL, REAL_MUL_LZERO, INTEGRABLE_0] THEN
  ASM_CASES_TAC ``c = &0:real`` THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``inv c:real`` o MATCH_MP INTEGRABLE_CMUL) THEN
  ASM_SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_MUL_LID, REAL_MUL_LINV, ETA_AX]);

val INTEGRABLE_NEG = store_thm ("INTEGRABLE_NEG",
 ``!f:real->real s.
        f integrable_on s ==> (\x. -f(x)) integrable_on s``,
  REWRITE_TAC[integrable_on] THEN METIS_TAC[HAS_INTEGRAL_NEG]);

val INTEGRABLE_SUB = store_thm ("INTEGRABLE_SUB",
 ``!f:real->real g s.
        f integrable_on s /\ g integrable_on s
        ==> (\x. f x - g x) integrable_on s``,
  REWRITE_TAC[integrable_on] THEN METIS_TAC[HAS_INTEGRAL_SUB]);

val INTEGRABLE_LINEAR = store_thm ("INTEGRABLE_LINEAR",
 ``!f h s. f integrable_on s /\ linear h ==> (h o f) integrable_on s``,
  REWRITE_TAC[integrable_on] THEN METIS_TAC[HAS_INTEGRAL_LINEAR]);

val INTEGRAL_LINEAR = store_thm ("INTEGRAL_LINEAR",
 ``!f:real->real s h:real->real.
        f integrable_on s /\ linear h
        ==> (integral s (h o f) = h(integral s f))``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_UNIQUE THEN
  MAP_EVERY EXISTS_TAC
   [``(h:real->real) o (f:real->real)``, ``s:real->bool``] THEN
  CONJ_TAC THENL [ALL_TAC, MATCH_MP_TAC HAS_INTEGRAL_LINEAR] THEN
  ASM_SIMP_TAC std_ss [GSYM HAS_INTEGRAL_INTEGRAL, INTEGRABLE_LINEAR]);

val HAS_INTEGRAL_SUM = store_thm ("HAS_INTEGRAL_SUM",
 ``!f:'a->real->real s t.
        FINITE t /\
        (!a. a IN t ==> ((f a) has_integral (i a)) s)
        ==> ((\x. sum t (\a. f a x)) has_integral (sum t i)) s``,
  GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
  KNOW_TAC ``!t. ((!a. a IN t ==> ((f:'a->real->real) a has_integral i a) s) ==>
          ((\x. sum t (\a. f a x)) has_integral sum t i) s) =
             (\t. (!a. a IN t ==> (f a has_integral i a) s) ==>
          ((\x. sum t (\a. f a x)) has_integral sum t i) s) t`` THENL
  [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
  SIMP_TAC std_ss [SUM_CLAUSES, HAS_INTEGRAL_0, IN_INSERT] THEN
  REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC [METIS [] ``!x.  sum s' (\a. f a x) =
                               (\x. sum s' (\a. f a x)) x``] THEN
  MATCH_MP_TAC HAS_INTEGRAL_ADD THEN
  ASM_SIMP_TAC std_ss [ETA_AX] THEN CONJ_TAC THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC std_ss []);

val INTEGRAL_SUM = store_thm ("INTEGRAL_SUM",
 ``!f:'a->real->real s t.
        FINITE t /\
        (!a. a IN t ==> (f a) integrable_on s)
        ==> (integral s (\x. sum t (\a. f a x)) =
                  sum t (\a. integral s (f a)))``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN
  MATCH_MP_TAC HAS_INTEGRAL_SUM THEN ASM_SIMP_TAC std_ss [INTEGRABLE_INTEGRAL]);

val INTEGRABLE_SUM = store_thm ("INTEGRABLE_SUM",
 ``!f:'a->real->real s t.
        FINITE t /\
        (!a. a IN t ==> (f a) integrable_on s)
        ==>  (\x. sum t (\a. f a x)) integrable_on s``,
  REWRITE_TAC[integrable_on] THEN METIS_TAC[HAS_INTEGRAL_SUM]);

val HAS_INTEGRAL_EQ = store_thm ("HAS_INTEGRAL_EQ",
 ``!f:real->real g k s.
        (!x. x IN s ==> (f(x) = g(x))) /\
        (f has_integral k) s
        ==> (g has_integral k) s``,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
  ONCE_REWRITE_TAC [METIS [] ``(!x:real. x IN s ==> (f x - g x = 0:real)) =
                       (!x:real. x IN s ==> ((\x. f x - g x) x = 0:real))``] THEN
  DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP HAS_INTEGRAL_IS_0) MP_TAC) THEN
  REWRITE_TAC[AND_IMP_INTRO] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB) THEN
  SIMP_TAC std_ss [REAL_ARITH ``x - (x - y:real) = y``, ETA_AX, REAL_SUB_RZERO]);

val INTEGRABLE_EQ = store_thm ("INTEGRABLE_EQ",
 ``!f:real->real g s.
        (!x. x IN s ==> (f(x) = g(x))) /\
        f integrable_on s
        ==> g integrable_on s``,
  REWRITE_TAC[integrable_on] THEN METIS_TAC[HAS_INTEGRAL_EQ]);

val HAS_INTEGRAL_EQ_EQ = store_thm ("HAS_INTEGRAL_EQ_EQ",
 ``!f:real->real g k s.
        (!x. x IN s ==> (f(x) = g(x)))
        ==> ((f has_integral k) s <=> (g has_integral k) s)``,
  METIS_TAC[HAS_INTEGRAL_EQ]);

val HAS_INTEGRAL_NULL = store_thm ("HAS_INTEGRAL_NULL",
 ``!f:real->real a b.
    (content(interval[a,b]) = &0) ==> (f has_integral 0) (interval[a,b])``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[has_integral] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  EXISTS_TAC ``\x:real. ball(x,&1)`` THEN REWRITE_TAC[GAUGE_TRIVIAL] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
  MATCH_MP_TAC(REAL_ARITH ``(x = &0) /\ &0 < e ==> x < e:real``) THEN
  ASM_REWRITE_TAC[ABS_ZERO] THEN METIS_TAC[SUM_CONTENT_NULL]);

val HAS_INTEGRAL_NULL_EQ = store_thm ("HAS_INTEGRAL_NULL_EQ",
 ``!f a b i. (content(interval[a,b]) = &0)
             ==> ((f has_integral i) (interval[a,b]) <=> (i = 0))``,
  METIS_TAC[INTEGRAL_UNIQUE, HAS_INTEGRAL_NULL]);

val INTEGRAL_NULL = store_thm ("INTEGRAL_NULL",
 ``!f a b. (content(interval[a,b]) = &0)
           ==> (integral(interval[a,b]) f = 0)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN
  METIS_TAC[HAS_INTEGRAL_NULL]);

val INTEGRABLE_ON_NULL = store_thm ("INTEGRABLE_ON_NULL",
 ``!f a b. (content(interval[a,b]) = &0)
           ==> f integrable_on interval[a,b]``,
  REWRITE_TAC[integrable_on] THEN METIS_TAC[HAS_INTEGRAL_NULL]);

val HAS_INTEGRAL_EMPTY = store_thm ("HAS_INTEGRAL_EMPTY",
 ``!f. (f has_integral 0) {}``,
  METIS_TAC[HAS_INTEGRAL_NULL, CONTENT_EMPTY, EMPTY_AS_INTERVAL]);

val HAS_INTEGRAL_EMPTY_EQ = store_thm ("HAS_INTEGRAL_EMPTY_EQ",
 ``!f i. (f has_integral i) {} <=> (i = 0)``,
  MESON_TAC[HAS_INTEGRAL_UNIQUE, HAS_INTEGRAL_EMPTY]);

val INTEGRABLE_ON_EMPTY = store_thm ("INTEGRABLE_ON_EMPTY",
 ``!f. f integrable_on {}``,
  REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_EMPTY]);

val INTEGRAL_EMPTY = store_thm ("INTEGRAL_EMPTY",
 ``!f. integral {} f = 0``,
  MESON_TAC[EMPTY_AS_INTERVAL, INTEGRAL_UNIQUE, HAS_INTEGRAL_EMPTY]);

val HAS_INTEGRAL_REFL = store_thm ("HAS_INTEGRAL_REFL",
 ``!f a. (f has_integral 0) (interval[a,a])``,
  REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_NULL THEN
  SIMP_TAC std_ss [INTERVAL_SING, INTERIOR_CLOSED_INTERVAL, CONTENT_EQ_0_INTERIOR]);

val INTEGRABLE_ON_REFL = store_thm ("INTEGRABLE_ON_REFL",
 ``!f a. f integrable_on interval[a,a]``,
  REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_REFL]);

val INTEGRAL_REFL = store_thm ("INTEGRAL_REFL",
 ``!f a. integral (interval[a,a]) f = 0``,
  MESON_TAC[INTEGRAL_UNIQUE, HAS_INTEGRAL_REFL]);

(* ------------------------------------------------------------------------- *)
(* Cauchy-type criterion for integrability.                                  *)
(* ------------------------------------------------------------------------- *)

val INTEGRABLE_CAUCHY = store_thm ("INTEGRABLE_CAUCHY",
 ``!f:real->real a b.
    f integrable_on interval[a,b] <=>
   !e. &0 < e ==> ?d. gauge d /\
   !p1 p2. p1 tagged_division_of interval[a,b] /\ d FINE p1 /\
       p2 tagged_division_of interval[a,b] /\ d FINE p2
       ==> abs (sum p1 (\(x,k). content k * f x) -
           sum p2 (\(x,k). content k * f x)) < e``,
  REPEAT GEN_TAC THEN REWRITE_TAC[integrable_on, has_integral] THEN
  EQ_TAC THEN DISCH_TAC THENL
  [X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
   FIRST_X_ASSUM(X_CHOOSE_THEN ``y:real`` (MP_TAC o SPEC ``e / &2:real``)) THEN
   ASM_REWRITE_TAC[REAL_HALF] THEN
   DISCH_THEN (X_CHOOSE_TAC ``d:real->real->bool``) THEN
   EXISTS_TAC ``d:real->real->bool`` THEN POP_ASSUM MP_TAC THEN
   REWRITE_TAC[GSYM dist] THEN MESON_TAC[DIST_TRIANGLE_HALF_L],
   ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o GEN ``n:num`` o SPEC ``inv(&n + &1:real)``) THEN
  SIMP_TAC std_ss [REAL_LT_INV_EQ, METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0]
    ``&0 < &n + &1:real``, SKOLEM_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN ``d:num->real->real->bool`` MP_TAC) THEN
  SIMP_TAC std_ss [FORALL_AND_THM] THEN STRIP_TAC THEN
  MP_TAC(GEN ``n:num``
   (ISPECL [``\x. BIGINTER {(d:num->real->real->bool) i x | i IN 0:num..n}``,
    ``a:real``, ``b:real``] FINE_DIVISION_EXISTS)) THEN
  ASM_SIMP_TAC std_ss [GAUGE_BIGINTER, FINE_BIGINTER, FINITE_NUMSEG, SKOLEM_THM] THEN
  SIMP_TAC std_ss [IN_NUMSEG, LE_0, FORALL_AND_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN ``p:num->(real#(real->bool))->bool``
   STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
  ``cauchy (\n. sum (p n)
    (\(x,k:real->bool). content k * (f:real->real) x))``
    MP_TAC THENL
  [REWRITE_TAC[cauchy] THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
   POP_ASSUM MP_TAC THEN GEN_REWR_TAC LAND_CONV [REAL_ARCH_INV] THEN
   DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
   POP_ASSUM MP_TAC THEN STRIP_TAC THEN
   KNOW_TAC ``!m n. (\m n.
   m >= (N :num) /\ n >= N ==>
   (dist
     ((\(n :num).
         sum ((p :num -> real # (real -> bool) -> bool) n)
           (\((x :real),(k :real -> bool)).
              content k * (f :real -> real) x)) m,
      (\(n :num).
         sum (p n) (\((x :real),(k :real -> bool)). content k * f x))
        n) :real) < (e :real)) m n`` THENL
   [ALL_TAC, SIMP_TAC std_ss []] THEN MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL
   [MESON_TAC[DIST_SYM], ALL_TAC] THEN
   MAP_EVERY X_GEN_TAC [``m:num``, ``n:num``] THEN REWRITE_TAC[GE] THEN
   SIMP_TAC std_ss [] THEN REPEAT STRIP_TAC THEN
   MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ``inv(&m + &1:real)`` THEN
   CONJ_TAC THENL
   [REWRITE_TAC[dist] THEN ASM_MESON_TAC[LESS_EQ_REFL], ALL_TAC] THEN
   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``inv(&N:real)`` THEN
   ASM_SIMP_TAC std_ss [REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
   ASM_SIMP_TAC arith_ss [REAL_OF_NUM_ADD, REAL_OF_NUM_LE, REAL_LT],
   ALL_TAC] THEN
  REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY, LIM_SEQUENTIALLY] THEN
  DISCH_THEN (X_CHOOSE_TAC ``y:real``) THEN EXISTS_TAC ``y:real`` THEN
  POP_ASSUM MP_TAC THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  MP_TAC(SPEC ``e / &2:real`` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN ``N1:num`` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_TAC ``N2:num``) THEN EXISTS_TAC
   ``(d:num->real->real->bool) (N1 + N2)`` THEN
  ASM_REWRITE_TAC[] THEN
  X_GEN_TAC ``q:(real#(real->bool))->bool`` THEN STRIP_TAC THEN
  REWRITE_TAC[GSYM dist] THEN MATCH_MP_TAC DIST_TRIANGLE_HALF_L THEN
  EXISTS_TAC ``sum (p(N1+N2:num))
   (\(x,k:real->bool). content k * (f:real->real) x)`` THEN
  CONJ_TAC THENL
  [REWRITE_TAC[dist] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
  EXISTS_TAC ``inv(&(N1 + N2) + &1:real)`` THEN CONJ_TAC THENL
  [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[LESS_EQ_REFL], ALL_TAC] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``inv(&N1:real)`` THEN
  ASM_SIMP_TAC std_ss [REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
  ASM_SIMP_TAC arith_ss [REAL_OF_NUM_ADD, REAL_OF_NUM_LE, REAL_LT],
  ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[dist] THEN
  FULL_SIMP_TAC std_ss []]);

(* ------------------------------------------------------------------------- *)
(* Additivity of integral on abutting intervals.                             *)
(* ------------------------------------------------------------------------- *)

val INTERVAL_SPLIT = store_thm ("INTERVAL_SPLIT",
 ``!a b:real c. (interval[a,b] INTER {x | x <= c} = interval[a,min b c]) /\
                (interval[a,b] INTER {x | x >= c} = interval[max a c,b])``,
  REPEAT STRIP_TAC THEN
  SIMP_TAC std_ss [EXTENSION, IN_INTERVAL, IN_INTER, GSPECIFICATION] THEN
  X_GEN_TAC ``y:real`` THEN
  MATCH_MP_TAC(TAUT `(c ==> b) /\ (c ==> a) /\ (a /\ b ==> c)
                      ==> (a /\ b <=> c)`) THEN
  (CONJ_TAC THENL
  [ASM_MESON_TAC[REAL_MAX_LE, REAL_LE_MIN, real_ge], ALL_TAC]) THEN
  SIMP_TAC std_ss [LEFT_AND_FORALL_THM, real_ge] THEN CONJ_TAC THEN
  ASM_MESON_TAC[REAL_MAX_LE, REAL_LE_MIN]);

Theorem CONTENT_SPLIT :
    !a b:real k. (content(interval[a,b]) =
                 content(interval[a,b] INTER {x | x <= c}) +
                 content(interval[a,b] INTER {x | x >= c}))
Proof
    rpt GEN_TAC
 >> SIMP_TAC std_ss [INTERVAL_SPLIT, CONTENT_CLOSED_INTERVAL_CASES,
                     min_def, max_def]
 >> rpt COND_CASES_TAC
 >> TRY (fs [] >> rfs [] >> rpt (POP_ASSUM MP_TAC) >> REAL_ARITH_TAC)
 >> (Cases_on `b <= c` >> fs [] >> rfs [])
QED

val lemma = Q.prove (
   `!a b:real c.
      ((content(interval[a,b] INTER {x | x <= c}) = &0) <=>
       (interior(interval[a,b] INTER {x | x <= c}) = {})) /\
      ((content(interval[a,b] INTER {x | x >= c}) = &0) <=>
       (interior(interval[a,b] INTER {x | x >= c}) = {}))`,
    SIMP_TAC std_ss [INTERVAL_SPLIT, CONTENT_EQ_0_INTERIOR]);

val DIVISION_SPLIT_LEFT_RIGHT_INJ = store_thm ("DIVISION_SPLIT_LEFT_RIGHT_INJ",
 ``(!d i k1 k2 k c.
     d division_of i /\
     k1 IN d /\ k2 IN d /\ ~(k1 = k2) /\
     (k1 INTER {x | x <= c} = k2 INTER {x | x <= c})
     ==> (content(k1 INTER {x:real | x <= c}) = &0)) /\
   (!d i k1 k2 k c.
     d division_of i /\
     k1 IN d /\ k2 IN d /\ ~(k1 = k2) /\
     (k1 INTER {x | x >= c} = k2 INTER {x | x >= c})
     ==> (content(k1 INTER {x:real | x >= c}) = &0))``,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[CONTENT_EQ_0_INTERIOR] THEN
  UNDISCH_TAC ``d division_of i`` THEN GEN_REWR_TAC LAND_CONV [division_of] THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (MP_TAC o CONJUNCT1) o CONJUNCT2) THEN
  DISCH_THEN(MP_TAC o SPECL
  [``k1:real->bool``, ``k2:real->bool``]) THEN
  ASM_REWRITE_TAC[PAIR_EQ] THEN DISCH_TAC THEN
  DISCH_THEN(MP_TAC o SPEC ``k2:real->bool``) THEN
  ASM_REWRITE_TAC[] THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN ``u:real`` (X_CHOOSE_THEN ``v:real``
   SUBST_ALL_TAC)) THEN
  ASM_SIMP_TAC std_ss [lemma] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
   ``(s INTER t = {})
     ==> u SUBSET s /\ u SUBSET t ==> (u = {})``)) THEN
  CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN ASM_SET_TAC[]);

val DIVISION_SPLIT_LEFT_INJ = store_thm ("DIVISION_SPLIT_LEFT_INJ",
  ``(!d i k1 k2 k c.
     d division_of i /\
     k1 IN d /\ k2 IN d /\ ~(k1 = k2) /\
     (k1 INTER {x | x <= c} = k2 INTER {x | x <= c})
     ==> (content(k1 INTER {x:real | x <= c}) = &0))``,
  REWRITE_TAC [DIVISION_SPLIT_LEFT_RIGHT_INJ]);

val DIVISION_SPLIT_RIGHT_INJ = store_thm ("DIVISION_SPLIT_RIGHT_INJ",
 ``(!d i k1 k2 k c.
     d division_of i /\
     k1 IN d /\ k2 IN d /\ ~(k1 = k2) /\
     (k1 INTER {x | x >= c} = k2 INTER {x | x >= c})
     ==> (content(k1 INTER {x:real | x >= c}) = &0))``,
  REWRITE_TAC [DIVISION_SPLIT_LEFT_RIGHT_INJ]);

val TAGGED_DIVISION_SPLIT_LEFT_INJ = store_thm ("TAGGED_DIVISION_SPLIT_LEFT_INJ",
 ``!d i x1 k1 x2 k2 c.
  d tagged_division_of i /\
  (x1,k1) IN d /\ (x2,k2) IN d /\ ~(k1 = k2) /\
  (k1 INTER {x | x <= c} = k2 INTER {x | x <= c})
  ==> (content(k1 INTER {x:real | x <= c}) = &0)``,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_TAGGED_DIVISION) THEN
  MATCH_MP_TAC DIVISION_SPLIT_LEFT_INJ THEN
  EXISTS_TAC ``IMAGE SND (d:(real#(real->bool))->bool)`` THEN
  ASM_REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[SND]);

val TAGGED_DIVISION_SPLIT_RIGHT_INJ = store_thm ("TAGGED_DIVISION_SPLIT_RIGHT_INJ",
 ``!d i x1 k1 x2 k2 c.
  d tagged_division_of i /\
  (x1,k1) IN d /\ (x2,k2) IN d /\ ~(k1 = k2) /\
  (k1 INTER {x | x >= c} = k2 INTER {x | x >= c})
   ==> (content(k1 INTER {x:real | x >= c}) = &0)``,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_TAGGED_DIVISION) THEN
  MATCH_MP_TAC DIVISION_SPLIT_RIGHT_INJ THEN
  EXISTS_TAC ``IMAGE SND (d:(real#(real->bool))->bool)`` THEN
  ASM_REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[SND]);

val DIVISION_SPLIT = store_thm ("DIVISION_SPLIT",
 ``!p a b:real c.
    p division_of interval[a,b]
    ==> {l INTER {x | x <= c} |l| l IN p /\ ~(l INTER {x | x <= c} = {})}
   division_of (interval[a,b] INTER {x | x <= c}) /\
   {l INTER {x | x >= c} |l| l IN p /\ ~(l INTER {x | x >= c} = {})}
   division_of (interval[a,b] INTER {x | x >= c})``,
  REPEAT GEN_TAC THEN
  SIMP_TAC std_ss [division_of, IMAGE_FINITE] THEN
  SIMP_TAC std_ss [SET_RULE ``(!x. x IN {f x | P x} ==> Q x) <=> (!x. P x ==> Q (f x))``,
   MESON[] ``(!x y. x IN s /\ y IN t /\ Q x y ==> P x y) <=>
               (!x. x IN s ==> !y. y IN t ==> Q x y ==> P x y)``,
   RIGHT_FORALL_IMP_THM] THEN
  REPEAT(MATCH_MP_TAC(TAUT
   `(a ==> a' /\ a'') /\ (b ==> b' /\ b'')
    ==> a /\ b ==> (a' /\ b') /\ (a'' /\ b'')`) THEN CONJ_TAC) THENL
  [KNOW_TAC ``FINITE p
 ==> FINITE {y | y IN IMAGE (\l. l INTER {x | x <= c:real}) p /\ ~(y = {})} /\
     FINITE {y | y IN IMAGE (\l. l INTER {x | x >= c:real}) p /\ ~(y = {})}`` THENL
   [ALL_TAC, METIS_TAC [SET_RULE
   ``{f x |x| x IN s /\ ~(f x = {})} = {y | y IN IMAGE f s /\ ~(y = {})}``]] THEN
   SIMP_TAC std_ss [FINITE_RESTRICT, IMAGE_FINITE],
   SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN
   DISCH_TAC THEN STRIP_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `l:real->bool`) THEN
   DISCH_THEN(fn th => CONJ_TAC THEN STRIP_TAC THEN MP_TAC th) THEN
  (ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_AND THEN
   CONJ_TAC THENL [SET_TAC[], ALL_TAC] THEN
   STRIP_TAC THEN METIS_TAC[INTERVAL_SPLIT]),
   DISCH_THEN(fn th => CONJ_TAC THEN MP_TAC th) THEN
  (DISCH_TAC THEN X_GEN_TAC ``K1:real->bool`` THEN
   POP_ASSUM (MP_TAC o Q.SPEC `K1:real->bool`) THEN
   DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC std_ss [] THEN
   DISCH_TAC THEN X_GEN_TAC ``K2:real->bool`` THEN
   POP_ASSUM (MP_TAC o Q.SPEC `K2:real->bool`) THEN
   DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC std_ss [] THEN
   DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC std_ss [] THEN
   KNOW_TAC ``(K1 <> K2:real->bool)`` THENL [ASM_MESON_TAC[PAIR_EQ],
    DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
   MATCH_MP_TAC(SET_RULE
   ``s SUBSET s' /\ t SUBSET t'
     ==> (s' INTER t' = {}) ==> (s INTER t = {})``) THEN
   CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[]),
  DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[INTER_BIGUNION] THEN
  ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[IN_BIGUNION] THEN
  CONJ_TAC THEN GEN_TAC THEN AP_TERM_TAC THEN
  GEN_REWR_TAC I [FUN_EQ_THM] THEN GEN_TAC THEN
  SIMP_TAC std_ss [GSPECIFICATION, PAIR_EQ] THEN MESON_TAC[NOT_IN_EMPTY]]);

val lemma1 = Q.prove (
  `(!x k. (x,k) IN {x,f k | P x k} ==> Q x k) <=>
   (!x k. P x k ==> Q x (f k))`,
  SIMP_TAC std_ss [GSPECIFICATION, PAIR_EQ, EXISTS_PROD] THEN SET_TAC[]);

val lemma2 = Q.prove (
   `!f:'b->'b s:('a#'b)->bool.
    FINITE s ==> FINITE {x,f k | (x,k) IN s /\ P x k}`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN
  EXISTS_TAC ``IMAGE (\(x:'a,k:'b). x,(f k:'b)) s`` THEN
  ASM_SIMP_TAC std_ss [IMAGE_FINITE] THEN
  SIMP_TAC std_ss [SUBSET_DEF, FORALL_PROD, lemma1, IN_IMAGE] THEN
  SIMP_TAC std_ss [EXISTS_PROD, PAIR_EQ] THEN MESON_TAC[]);

val lemma3 = Q.prove (
   `!f:real->real g:(real->bool)->(real->bool) p.
  FINITE p
  ==> (sum {x,g k |x,k| (x,k) IN p /\ ~(g k = {})} (\(x,k). content k * f x) =
       sum (IMAGE (\(x,k). x,g k) p) (\(x,k). content k * f x))`,
  REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN
  ASM_SIMP_TAC std_ss [IMAGE_FINITE, lemma2] THEN
  SIMP_TAC std_ss [IMP_CONJ, FORALL_IN_IMAGE] THEN
  SIMP_TAC std_ss [FORALL_PROD, SUBSET_DEF, IN_IMAGE, EXISTS_PROD] THEN
  SIMP_TAC std_ss [GSPECIFICATION, PAIR_EQ, REAL_ENTIRE, EXISTS_PROD] THEN
  METIS_TAC[CONTENT_EMPTY]);

val lemma4 = Q.prove (
  `(\(x,l). content (g l) * f x) =
   (\(x,l). content l * f x) o (\(x,l). x,g l)`,
  SIMP_TAC std_ss [FUN_EQ_THM, o_THM, FORALL_PROD]);

val HAS_INTEGRAL_SPLIT = store_thm ("HAS_INTEGRAL_SPLIT",
 ``!f:real->real a b c.
   (f has_integral i) (interval[a,b] INTER {x | x <= c}) /\
   (f has_integral j) (interval[a,b] INTER {x | x >= c})
   ==> (f has_integral (i + j)) (interval[a,b])``,
  REPEAT GEN_TAC THEN
  ASM_SIMP_TAC std_ss [INTERVAL_SPLIT] THEN REWRITE_TAC[has_integral] THEN
  ASM_SIMP_TAC std_ss [GSYM INTERVAL_SPLIT] THEN
  DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN STRIP_TAC THEN
  FIRST_X_ASSUM(CONJUNCTS_THEN2 (MP_TAC o SPEC ``e / &2:real``) STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN ``d2:real->real->bool``
   (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN ``d1:real->real->bool``
   (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN
  EXISTS_TAC ``\x. if x = c then (d1(x:real) INTER d2(x)):real->bool
                 else ball(x,abs(x - c)) INTER d1(x) INTER d2(x)`` THEN
  CONJ_TAC THENL
  [REWRITE_TAC[gauge_def] THEN GEN_TAC THEN
   RULE_ASSUM_TAC(REWRITE_RULE[gauge_def]) THEN BETA_TAC THEN COND_CASES_TAC THEN
   ASM_SIMP_TAC std_ss [OPEN_INTER, IN_INTER, OPEN_BALL, IN_BALL] THEN
   ASM_REWRITE_TAC[DIST_REFL, GSYM ABS_NZ, REAL_SUB_0], ALL_TAC] THEN
  X_GEN_TAC ``p:(real#(real->bool))->bool`` THEN STRIP_TAC THEN
  SUBGOAL_THEN
   ``(!x:real kk. (x,kk) IN p /\ ~(kk INTER {x:real | x <= c} = {})
      ==> x <= c) /\
     (!x:real kk. (x,kk) IN p /\ ~(kk INTER {x:real | x >= c} = {})
      ==> x >= c)``
  STRIP_ASSUME_TAC THENL
  [CONJ_TAC THEN FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [FINE]) THEN
   DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN
   POP_ASSUM (MP_TAC o Q.SPECL [`x:real`, `kk:real->bool`]) THEN
   DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC std_ss [] THEN
   COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL, real_ge] THEN DISCH_THEN
    (MP_TAC o MATCH_MP (SET_RULE ``k SUBSET (a INTER b) ==> k SUBSET a``)) THEN
   DISCH_THEN
    (MP_TAC o MATCH_MP (SET_RULE ``k SUBSET (a INTER b) ==> k SUBSET a``)) THEN
   SIMP_TAC std_ss [SUBSET_DEF, IN_BALL, dist] THEN DISCH_TAC THENL
   [UNDISCH_TAC ``kk INTER {x:real | x <= c} <> {}``,
    UNDISCH_TAC ``kk INTER {x:real | x >= c} <> {}``] THEN DISCH_TAC THEN
   FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
   DISCH_THEN(X_CHOOSE_THEN ``u:real`` MP_TAC) THEN
   SIMP_TAC std_ss [IN_INTER, GSPECIFICATION] THEN REPEAT STRIP_TAC THEN
   FIRST_X_ASSUM(MP_TAC o SPEC ``u:real``) THEN ASM_REWRITE_TAC[] THEN
   ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
   REWRITE_TAC[REAL_NOT_LE, REAL_NOT_LT] THEN STRIP_TAC THEN
   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``abs(x - u:real)`` THEN
   ASM_SIMP_TAC std_ss [REAL_LE_REFL] THEN REWRITE_TAC [abs] THEN
   REPEAT COND_CASES_TAC THENL
   [ASM_REWRITE_TAC [real_sub, REAL_LE_LADD, REAL_LE_NEG],
    FULL_SIMP_TAC std_ss [REAL_SUB_LE] THEN
    FULL_SIMP_TAC std_ss [REAL_NOT_LE] THEN CCONTR_TAC THEN
    UNDISCH_TAC ``x < u:real`` THEN REWRITE_TAC [REAL_NOT_LT] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC ``c:real`` THEN ASM_REWRITE_TAC [REAL_LE_LT],
    FULL_SIMP_TAC std_ss [REAL_SUB_LE] THEN
    FULL_SIMP_TAC std_ss [REAL_NOT_LE] THEN METIS_TAC [REAL_LT_ANTISYM],
    FULL_SIMP_TAC std_ss [REAL_SUB_LE] THEN
    FULL_SIMP_TAC std_ss [REAL_NOT_LE] THEN METIS_TAC [REAL_LT_ANTISYM],
    FULL_SIMP_TAC std_ss [REAL_SUB_LE] THEN
    FULL_SIMP_TAC std_ss [REAL_NOT_LE] THEN METIS_TAC [REAL_LET_ANTISYM],
    FULL_SIMP_TAC std_ss [REAL_SUB_LE] THEN
    FULL_SIMP_TAC std_ss [REAL_NOT_LE] THEN METIS_TAC [REAL_LET_ANTISYM],
    FULL_SIMP_TAC std_ss [REAL_SUB_LE, real_ge] THEN CCONTR_TAC THEN
    UNDISCH_TAC ``x < c:real`` THEN REWRITE_TAC [REAL_NOT_LT] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC ``u:real`` THEN ASM_REWRITE_TAC [REAL_LE_LT],
    ASM_REWRITE_TAC [REAL_LE_NEG, real_sub, REAL_LE_LADD] THEN
    ASM_REWRITE_TAC [GSYM real_ge]], ALL_TAC] THEN
   UNDISCH_TAC ``!p.
       p tagged_division_of interval [(a,b)] INTER {x | x >= c} /\
       d2 FINE p ==>
       abs (sum p (\(x,k). content k * f x) - j) < e / 2:real`` THEN
   DISCH_TAC THEN POP_ASSUM (MP_TAC o SPEC
   ``{(x:real,kk INTER {x:real | x >= c}) |(x,kk)|
     (x,kk) IN p /\ ~(kk INTER {x:real | x >= c} = {})}``) THEN
   UNDISCH_TAC ``!p.
       p tagged_division_of interval [(a,b)] INTER {x | x <= c} /\
       d1 FINE p ==>
       abs (sum p (\(x,k). content k * f x) - i) < e / 2:real`` THEN
   DISCH_TAC THEN POP_ASSUM (MP_TAC o SPEC
   ``{(x:real,kk INTER {x:real | x <= c}) |(x,kk)|
     (x,kk) IN p /\ ~(kk INTER {x:real | x <= c} = {})}``) THEN
   MATCH_MP_TAC(TAUT
   `(a /\ b) /\ (a' /\ b' ==> c) ==> (a ==> a') ==> (b ==> b') ==> c`) THEN
   CONJ_TAC THENL
   [UNDISCH_TAC ``p tagged_division_of interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [TAGGED_DIVISION_OF]) THEN
    REWRITE_TAC[TAGGED_DIVISION_OF] THEN
    REPEAT(MATCH_MP_TAC(TAUT
    `(a ==> (a' /\ a'')) /\ (b ==> (b' /\ d) /\ (b'' /\ e))
        ==> a /\ b ==> ((a' /\ b') /\ d) /\ ((a'' /\ b'') /\ e)`) THEN
    CONJ_TAC) THEN
    SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
    SIMP_TAC std_ss [lemma1] THEN REWRITE_TAC[AND_IMP_INTRO] THENL
   [SIMP_TAC std_ss [lemma2],
    SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN
    DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN
    POP_ASSUM (MP_TAC o Q.SPECL [`x:real`, `kk:real->bool`]) THEN
    DISCH_THEN(fn th => CONJ_TAC THEN STRIP_TAC THEN MP_TAC th) THEN
    (ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
     [SIMP_TAC std_ss [IN_INTER, GSPECIFICATION] THEN METIS_TAC[], ALL_TAC]) THEN
    (MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [SET_TAC[], ALL_TAC]) THEN
    METIS_TAC[INTERVAL_SPLIT],
   DISCH_THEN(fn th => CONJ_TAC THEN MP_TAC th) THEN
   (REPEAT (DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN
    POP_ASSUM (MP_TAC o Q.SPECL [`x1:real`, `kk:real->bool`])) THEN
    DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC std_ss [] THEN
    REPEAT (DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN
    POP_ASSUM (MP_TAC o Q.SPECL [`x2:real`, `kk':real->bool`])) THEN
    DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC std_ss []) THENL
    [ALL_TAC, KNOW_TAC ``kk <> kk':real->bool`` THENL
     [CCONTR_TAC THEN UNDISCH_TAC ``kk:real->bool INTER {x | x <= c} <> kk' INTER {x | x <= c}`` THEN
      REWRITE_TAC [] THEN AP_THM_TAC THEN AP_TERM_TAC THEN FULL_SIMP_TAC std_ss [],
      DISCH_TAC THEN ASM_REWRITE_TAC []],
     ALL_TAC, KNOW_TAC ``kk <> kk':real->bool`` THENL
     [CCONTR_TAC THEN UNDISCH_TAC ``kk:real->bool INTER {x | x >= c} <> kk' INTER {x | x >= c}`` THEN
      REWRITE_TAC [] THEN AP_THM_TAC THEN AP_TERM_TAC THEN FULL_SIMP_TAC std_ss [],
      DISCH_TAC THEN ASM_REWRITE_TAC []]] THEN
    MATCH_MP_TAC(SET_RULE
    ``s SUBSET s' /\ t SUBSET t'
     ==> (s' INTER t' = {}) ==> (s INTER t = {})``) THEN
    CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[],
  MATCH_MP_TAC(TAUT `(a ==> b /\ c) /\ d /\ e
   ==> (a ==> (b /\ d) /\ (c /\ e))`) THEN
  CONJ_TAC THENL
  [DISCH_THEN(fn th => CONJ_TAC THEN MP_TAC th) THEN
   DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[INTER_BIGUNION] THEN
   ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[IN_BIGUNION] THEN
   X_GEN_TAC ``x:real`` THEN AP_TERM_TAC THEN
   GEN_REWR_TAC I [FUN_EQ_THM] THEN X_GEN_TAC ``kk:real->bool`` THEN
   SIMP_TAC std_ss [GSPECIFICATION, PAIR_EQ, EXISTS_PROD] THEN MESON_TAC[NOT_IN_EMPTY],
   ALL_TAC] THEN
   UNDISCH_TAC `` (\x. if x = c then d1 x INTER d2 x
         else ball (x,abs (x - c)) INTER d1 x INTER d2 x) FINE p`` THEN
   DISCH_TAC THEN
   CONJ_TAC THEN FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [FINE]) THEN
   SIMP_TAC std_ss [FINE, lemma1] THEN
   REPEAT (DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN
    POP_ASSUM (MP_TAC o Q.SPECL [`x:real`, `kk:real->bool`])) THEN
   DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN
   ASM_SIMP_TAC std_ss [] THEN SET_TAC[]], ALL_TAC] THEN
   DISCH_THEN(MP_TAC o MATCH_MP (METIS [REAL_HALF, REAL_LT_ADD2]
     ``x < e / &2 /\ y < e / &2 ==> x + y < e:real``)) THEN
   DISCH_THEN(MP_TAC o MATCH_MP ABS_TRIANGLE_LT) THEN
   MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
   REWRITE_TAC[REAL_ARITH
   ``((a - i) + (b - j) = c - (i + j)) <=> (a + b = c:real)``] THEN
   FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
   MATCH_MP_TAC EQ_TRANS THEN
   EXISTS_TAC
   ``sum p (\(x,l). content (l INTER {x:real | x <= c}) *
     (f:real->real) x) +
     sum p (\(x,l). content (l INTER {x:real | x >= c}) *
     (f:real->real) x)`` THEN CONJ_TAC THENL
  [ALL_TAC,
   ASM_SIMP_TAC std_ss [GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_EQ THEN
   SIMP_TAC std_ss [FORALL_PROD, GSYM REAL_ADD_RDISTRIB] THEN
   MAP_EVERY X_GEN_TAC [``x:real``, ``l:real->bool``] THEN
   DISCH_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
   UNDISCH_TAC ``p tagged_division_of interval [(a,b)]`` THEN DISCH_TAC THEN
   FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [TAGGED_DIVISION_OF]) THEN
   ASM_REWRITE_TAC [] THEN STRIP_TAC THEN UNDISCH_TAC
    ``!x k. (x,k) IN p ==>
         x IN k /\ k SUBSET interval [(a,b)] /\
         ?a b. k = interval [(a,b)]`` THEN DISCH_TAC THEN
   POP_ASSUM (MP_TAC o Q.SPECL [`x:real`, `l:real->bool`]) THEN
   ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
   ASM_SIMP_TAC std_ss [GSYM CONTENT_SPLIT]] THEN
  ASM_SIMP_TAC std_ss [lemma3] THEN BINOP_TAC THEN
  (ONCE_REWRITE_TAC [METIS [] ``!x:real l:real->bool.
    ((l INTER {x | x <= c}) = (\l. l INTER {x | x <= c}) l) /\
    ((l INTER {x | x >= c}) = (\l. l INTER {x | x >= c}) l)``] THEN
   GEN_REWR_TAC (RAND_CONV o RAND_CONV) [lemma4] THEN
   MATCH_MP_TAC SUM_IMAGE_NONZERO THEN ASM_SIMP_TAC std_ss [FORALL_PROD] THEN
   REWRITE_TAC[PAIR_EQ] THEN
   METIS_TAC [TAGGED_DIVISION_SPLIT_LEFT_INJ, REAL_MUL_LZERO,
    TAGGED_DIVISION_SPLIT_RIGHT_INJ]));

(* ------------------------------------------------------------------------- *)
(* A sort of converse, integrability on subintervals.                        *)
(* ------------------------------------------------------------------------- *)

val TAGGED_DIVISION_UNION_INTERVAL = store_thm ("TAGGED_DIVISION_UNION_INTERVAL",
 ``!a b:real p1 p2 c.
   p1 tagged_division_of (interval[a,b] INTER {x | x <= c}) /\
   p2 tagged_division_of (interval[a,b] INTER {x | x >= c})
   ==> (p1 UNION p2) tagged_division_of (interval[a,b])``,
  REPEAT STRIP_TAC THEN SUBGOAL_THEN
  ``(interval[a,b] = (interval[a,b] INTER {x:real | x <= c}) UNION
                     (interval[a,b] INTER {x:real | x >= c}))``
                       SUBST1_TAC THENL
  [MATCH_MP_TAC(SET_RULE
   ``(t UNION u = UNIV) ==> (s = (s INTER t) UNION (s INTER u))``) THEN
   SIMP_TAC std_ss [EXTENSION, IN_UNIV, IN_UNION, GSPECIFICATION] THEN
   REAL_ARITH_TAC, ALL_TAC] THEN
  MATCH_MP_TAC TAGGED_DIVISION_UNION THEN ASM_REWRITE_TAC[] THEN
  ASM_SIMP_TAC std_ss [INTERVAL_SPLIT, INTERIOR_CLOSED_INTERVAL] THEN
  SIMP_TAC std_ss [EXTENSION, IN_INTER, NOT_IN_EMPTY, IN_INTERVAL] THEN
  GEN_TAC THEN REWRITE_TAC [GSYM DE_MORGAN_THM] THEN
  DISCH_THEN(CONJUNCTS_THEN (MP_TAC)) THEN REWRITE_TAC [min_def, max_def] THEN
  REPEAT COND_CASES_TAC THENL
  [STRIP_TAC THEN SIMP_TAC std_ss [REAL_NOT_LT] THEN DISJ2_TAC THEN
   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``c:real`` THEN
   ASM_SIMP_TAC arith_ss [REAL_LE_LT],
   SIMP_TAC std_ss [REAL_NOT_LT, REAL_LE_LT],
   STRIP_TAC THEN KNOW_TAC ``a < b /\ b < a:real`` THENL [CONJ_TAC THENL
   [MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC ``x:real`` THEN ASM_REWRITE_TAC [],
    MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ``c:real`` THEN
    FULL_SIMP_TAC std_ss [REAL_NOT_LE]], SIMP_TAC std_ss [REAL_LT_ANTISYM]],
   STRIP_TAC THEN FULL_SIMP_TAC std_ss [REAL_NOT_LE, REAL_NOT_LT] THEN
   DISJ2_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``a:real`` THEN
   ASM_SIMP_TAC std_ss [REAL_LE_LT]]);

val HAS_INTEGRAL_SEPARATE_SIDES = store_thm ("HAS_INTEGRAL_SEPARATE_SIDES",
 ``!f:real->real i a b.
   (f has_integral i) (interval[a,b])
   ==> !e. &0 < e ==> ?d. gauge d /\
       !p1 p2. p1 tagged_division_of
        (interval[a,b] INTER {x | x <= c}) /\ d FINE p1 /\
           p2 tagged_division_of
        (interval[a,b] INTER {x | x >= c}) /\ d FINE p2
       ==> abs ((sum p1 (\(x,k). content k * f x) +
                 sum p2 (\(x,k). content k * f x)) - i) < e``,
  REWRITE_TAC[has_integral] THEN REPEAT GEN_TAC THEN
  DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `e:real`) THEN
  ASM_CASES_TAC ``&0 < e:real`` THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN (X_CHOOSE_TAC ``d:real->real->bool``) THEN
  EXISTS_TAC ``d:real->real->bool`` THEN POP_ASSUM MP_TAC THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   ``sum p1 (\(x,k). content k * f x) + sum p2 (\(x,k). content k * f x) =
     sum (p1 UNION p2) (\(x,k:real->bool). content k * (f:real->real) x)``
    SUBST1_TAC THENL
  [ALL_TAC, METIS_TAC[TAGGED_DIVISION_UNION_INTERVAL, FINE_UNION]] THEN
  CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNION_NONZERO THEN
  UNDISCH_TAC ``p2 tagged_division_of interval [(a,b)] INTER {x | x >= c}`` THEN
  DISCH_TAC THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE [TAGGED_DIVISION_OF]) THEN
  UNDISCH_TAC ``p1 tagged_division_of interval [(a,b)] INTER {x | x <= c}`` THEN
  DISCH_TAC THEN  FIRST_X_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE [TAGGED_DIVISION_OF]) THEN
  ASM_SIMP_TAC std_ss [FORALL_PROD] THEN
  MAP_EVERY X_GEN_TAC [``x:real``, ``l:real->bool``] THEN
  REWRITE_TAC [IN_INTER, REAL_ENTIRE] THEN STRIP_TAC THEN DISJ1_TAC THEN
  SUBGOAL_THEN
  ``(?a b:real. l = interval[a,b]) /\
    l SUBSET (interval[a,b] INTER {x | x <= c}) /\
    l SUBSET (interval[a,b] INTER {x | x >= c})``
   MP_TAC THENL [ASM_MESON_TAC[], ALL_TAC] THEN
  DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
  ASM_REWRITE_TAC[SET_RULE
  ``s SUBSET t /\ s SUBSET u <=> s SUBSET (t INTER u)``] THEN
  ASM_SIMP_TAC std_ss [INTERVAL_SPLIT, INTER_INTERVAL] THEN
  DISCH_THEN(MP_TAC o MATCH_MP SUBSET_INTERIOR) THEN
  REWRITE_TAC[INTERIOR_CLOSED_INTERVAL, CONTENT_EQ_0_INTERIOR] THEN
  MATCH_MP_TAC(SET_RULE ``(t = {}) ==> s SUBSET t ==> (s = {})``) THEN
  SIMP_TAC std_ss [GSYM INTERVAL_EQ_EMPTY] THEN
  RW_TAC std_ss [REAL_MIN_LE, REAL_LE_MAX] THEN REAL_ARITH_TAC);

val lemma = Q.prove (
   `(b - a = c) ==>
     abs (a:real) < e / &2 ==> abs (b) < e / &2 ==> abs (c) < e`,
  DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM dist] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC DIST_TRIANGLE_HALF_L THEN
  EXISTS_TAC ``0:real`` THEN
  ASM_SIMP_TAC std_ss [dist, REAL_SUB_LZERO, REAL_SUB_RZERO, ABS_NEG]);

val INTEGRABLE_SPLIT = store_thm ("INTEGRABLE_SPLIT",
 ``!f:real->real a b.
    f integrable_on (interval[a,b])
    ==> f integrable_on (interval[a,b] INTER {x | x <= c}) /\
        f integrable_on (interval[a,b] INTER {x | x >= c})``,
  REPEAT GEN_TAC THEN
  GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV) [integrable_on] THEN
  SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM, GSYM LEFT_EXISTS_AND_THM] THEN
  X_GEN_TAC ``y:real`` THEN DISCH_TAC THEN CONJ_TAC THEN
  ASM_SIMP_TAC std_ss [INTERVAL_SPLIT, INTEGRABLE_CAUCHY] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o SPEC ``e / &2:real`` o
   MATCH_MP HAS_INTEGRAL_SEPARATE_SIDES) THEN
  MAP_EVERY ABBREV_TAC
  [``b' = min (b:real) c``, ``a' = max (a:real) c``] THEN
  ASM_SIMP_TAC std_ss [REAL_HALF, INTERVAL_SPLIT] THEN
  DISCH_THEN (X_CHOOSE_TAC ``d:real->real->bool``) THEN
  EXISTS_TAC ``d:real->real->bool`` THEN POP_ASSUM MP_TAC THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP FINE_DIVISION_EXISTS) THENL
  [DISCH_THEN(MP_TAC o SPECL [``a':real``, ``b:real``]) THEN
   KNOW_TAC ``! (p2 :real # (real -> bool) -> bool)
                (p1 :real # (real -> bool) -> bool).
        p1 tagged_division_of interval [((a :real),(b' :real))] /\
        (d :real -> real -> bool) FINE p1 /\
        p2 tagged_division_of interval [((a' :real),(b :real))] /\
        d FINE p2 ==>
        abs (sum p1 (\((x :real),(k :real -> bool)).
                content k * (f :real -> real) x) +
           sum p2 (\((x :real),(k :real -> bool)). content k * f x) -
           (y :real)) < (e :real) / (2 :real)`` THENL
   [METIS_TAC [SWAP_FORALL_THM], POP_ASSUM K_TAC THEN DISCH_TAC],
   DISCH_THEN(MP_TAC o SPECL [``a:real``, ``b':real``])] THEN
  DISCH_THEN(X_CHOOSE_THEN ``p:(real#(real->bool))->bool``
   STRIP_ASSUME_TAC) THEN
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fn th =>
   MP_TAC(SPECL [``p:(real#(real->bool))->bool``,
   ``p1:(real#(real->bool))->bool``] th) THEN
   MP_TAC(SPECL [``p:(real#(real->bool))->bool``,
   ``p2:(real#(real->bool))->bool``] th)) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC lemma THEN REAL_ARITH_TAC);

(* ------------------------------------------------------------------------- *)
(* Generalized notion of additivity.                                         *)
(* ------------------------------------------------------------------------- *)

val operative = new_definition ("operative",
 ``operative op (f:(real->bool)->'a) <=>
  (!a b. (content(interval[a,b]) = &0) ==> (f(interval[a,b]) = neutral(op))) /\
  (!a b c. (f(interval[a,b]) = op (f(interval[a,b] INTER {x | x <= c}))
                                  (f(interval[a,b] INTER {x | x >= c}))))``);

val OPERATIVE_TRIVIAL = store_thm ("OPERATIVE_TRIVIAL",
 ``!op f a b.
  operative op f /\ (content(interval[a,b]) = &0)
  ==> (f(interval[a,b]) = neutral op)``,
 REWRITE_TAC[operative] THEN MESON_TAC[]);

val PROPERTY_EMPTY_INTERVAL = store_thm ("PROPERTY_EMPTY_INTERVAL",
 ``!P. (!a b:real. (content(interval[a,b]) = &0)
   ==> P(interval[a,b])) ==> P {}``,
  MESON_TAC[EMPTY_AS_INTERVAL, CONTENT_EMPTY]);

val OPERATIVE_EMPTY = store_thm ("OPERATIVE_EMPTY",
 ``!op f:(real->bool)->'a. operative op f ==> (f {} = neutral op)``,
  REPEAT GEN_TAC THEN REWRITE_TAC[operative] THEN
  DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC o SPECL [``1:real``, ``0:real``]) ASSUME_TAC) THEN
  ASSUME_TAC INTERVAL_EQ_EMPTY THEN POP_ASSUM (MP_TAC o Q.SPECL [`1:real`, `0:real`]) THEN
  REWRITE_TAC [REAL_ARITH ``0 < 1:real``] THEN STRIP_TAC THEN
  ASM_REWRITE_TAC [CONTENT_EMPTY] THEN METIS_TAC []);

(* ------------------------------------------------------------------------- *)
(* Using additivity of lifted function to encode definedness.                *)
(* ------------------------------------------------------------------------- *)

val lifted = Define
  `(lifted op NONE _ = NONE) /\
   (lifted op _ NONE = NONE) /\
   (lifted op (SOME x) (SOME y) = SOME(op x y))`;

val NEUTRAL_LIFTED = store_thm ("NEUTRAL_LIFTED",
 ``!op. monoidal op ==> (neutral(lifted op) = SOME(neutral op))``,
  REWRITE_TAC[neutral, monoidal] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC SELECT_UNIQUE THEN
  SIMP_TAC std_ss [FORALL_OPTION, lifted, NOT_NONE_SOME, option_CLAUSES] THEN
  ASM_MESON_TAC[]);

val MONOIDAL_LIFTED = store_thm ("MONOIDAL_LIFTED",
 ``!op. monoidal op ==> monoidal(lifted op)``,
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC std_ss [NEUTRAL_LIFTED, monoidal] THEN
  SIMP_TAC std_ss [FORALL_OPTION, lifted, NOT_NONE_SOME, option_CLAUSES] THEN
  ASM_MESON_TAC[monoidal]);

val ITERATE_SOME = store_thm ("ITERATE_SOME",
 ``!op. monoidal op ==> !f s. FINITE s
   ==> (iterate (lifted op) s (\x. SOME(f x)) =
           SOME(iterate op s f))``,
  GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
  KNOW_TAC ``!(s :'b -> bool).
               FINITE s ==>
               (\s. (iterate (lifted (op :'a -> 'a -> 'a)) s
                   (\(x :'b). SOME ((f :'b -> 'a) x)) =
                 SOME (iterate op s f))) s`` THENL
  [ALL_TAC, SIMP_TAC std_ss []] THEN
  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
  ASM_SIMP_TAC std_ss [ITERATE_CLAUSES, MONOIDAL_LIFTED, NEUTRAL_LIFTED] THEN
  SIMP_TAC std_ss [lifted]);

(* ------------------------------------------------------------------------- *)
(* Two key instances of additivity.                                          *)
(* ------------------------------------------------------------------------- *)

val OPERATIVE_CONTENT = store_thm ("OPERATIVE_CONTENT",
 ``operative(+) content``,
  REWRITE_TAC[operative, NEUTRAL_REAL_ADD, CONTENT_SPLIT]);

val OPERATIVE_INTEGRAL = store_thm ("OPERATIVE_INTEGRAL",
 ``!f:real->real. operative(lifted(+))
   (\i. if f integrable_on i then SOME(integral i f) else NONE)``,
  SIMP_TAC std_ss [operative, NEUTRAL_LIFTED, MONOIDAL_REAL_ADD] THEN
  SIMP_TAC std_ss [NEUTRAL_REAL_ADD] THEN
  REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC std_ss []) THEN
  REWRITE_TAC[lifted, NOT_NONE_SOME, option_CLAUSES] THENL
  [REWRITE_TAC [integrable_on] THEN
   ASM_MESON_TAC[HAS_INTEGRAL_NULL],
   REWRITE_TAC[integral] THEN METIS_TAC[HAS_INTEGRAL_NULL_EQ],
   REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL)) THEN
   METIS_TAC[HAS_INTEGRAL_SPLIT, HAS_INTEGRAL_UNIQUE],
   METIS_TAC[INTEGRABLE_SPLIT, integrable_on],
   METIS_TAC[INTEGRABLE_SPLIT],
   METIS_TAC[INTEGRABLE_SPLIT],
   RULE_ASSUM_TAC(REWRITE_RULE[integrable_on]) THEN
   METIS_TAC[HAS_INTEGRAL_SPLIT]]);

(* ------------------------------------------------------------------------- *)
(* Points of division of a partition.                                        *)
(* ------------------------------------------------------------------------- *)

val _ = hide "division_points";

val division_points = new_definition ("division_points",
 ``division_points (k:real->bool) (d:(real->bool)->bool) =
   {(j,x) | (1:num <= j) /\ (j <= 1:num) /\ (interval_lowerbound k) < x /\
                          x < (interval_upperbound k) /\
        ?i. i IN d /\ ((interval_lowerbound i = x) \/
                       (interval_upperbound i = x))}``);

val DIVISION_POINTS_FINITE = store_thm ("DIVISION_POINTS_FINITE",
 ``!d i:real->bool. d division_of i ==> FINITE(division_points i d)``,
  REWRITE_TAC[division_of, division_points] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[CONJ_ASSOC, GSYM IN_NUMSEG] THEN
  REWRITE_TAC[SPECIFICATION, GSYM CONJ_ASSOC] THEN
  KNOW_TAC ``FINITE {(\j x. (j,x)) j x |
   j IN (1 .. 1) /\ x IN (\j x. interval_lowerbound i < x /\
                     x < interval_upperbound i /\ ?i. d i /\
     ((interval_lowerbound i = x) \/ (interval_upperbound i = x))) j }`` THENL
  [ALL_TAC, BETA_TAC THEN SIMP_TAC std_ss [SPECIFICATION]] THEN
  MATCH_MP_TAC FINITE_PRODUCT_DEPENDENT THEN
  SIMP_TAC std_ss [ETA_AX, FINITE_NUMSEG] THEN
  X_GEN_TAC ``j:num`` THEN
  REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN
  MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC
   ``IMAGE (\i:real->bool. (interval_lowerbound i)) d UNION
     IMAGE (\i:real->bool. (interval_upperbound i)) d`` THEN
  ASM_SIMP_TAC std_ss [FINITE_UNION, IMAGE_FINITE] THEN
  SIMP_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_UNION, GSPECIFICATION] THEN
  REWRITE_TAC [SPECIFICATION] THEN BETA_TAC THEN
  MESON_TAC[SPECIFICATION]);

val DIVISION_POINTS_SUBSET = store_thm ("DIVISION_POINTS_SUBSET",
 ``!a b:real c d k.
      d division_of interval[a,b] /\ a < b /\ a < c /\ c < b
    ==> division_points (interval[a,b] INTER {x | x <= c})
         {l INTER {x | x <= c} | l |
          l IN d /\ ~(l INTER {x | x <= c} = {})}
   SUBSET division_points (interval[a,b]) d /\
          division_points (interval[a,b] INTER {x | x >= c})
         {l INTER {x | x >= c} | l |
          l IN d /\ ~(l INTER {x | x >= c} = {})}
   SUBSET division_points (interval[a,b]) d``,
  REPEAT STRIP_TAC THEN
  (SIMP_TAC std_ss [SUBSET_DEF, division_points, FORALL_PROD] THEN
   MAP_EVERY X_GEN_TAC [``j:num``, ``x:real``] THEN
   SIMP_TAC std_ss [IN_ELIM_PAIR_THM] THEN SIMP_TAC std_ss [GSPECIFICATION] THEN
   ASM_SIMP_TAC std_ss [INTERVAL_SPLIT, INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND,
    REAL_LT_IMP_LE] THEN
   ASM_SIMP_TAC std_ss [METIS [max_def, REAL_LT_IMP_LE] ``a < c ==> (max a c = c:real)``,
                        METIS [min_def, REAL_NOT_LE] ``c < b ==> (min b c = c:real)``] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  ASM_SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_LOWERBOUND,
   REAL_LT_IMP_LE, COND_ID,
  METIS [] ``(a <= if p then x else y) <=> (if p then a <= x else a <= y)``,
  METIS [] ``(if p then x else y) <= a <=> (if p then x <= a else y <= a)``] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(fn th => CONJ_TAC THEN MP_TAC th) THENL
  [DISCH_THEN(K ALL_TAC) THEN REPEAT(POP_ASSUM MP_TAC) THEN
   ASM_SIMP_TAC arith_ss [] THEN REAL_ARITH_TAC, ALL_TAC]) THENL
  [KNOW_TAC ``!l. (?i. ((l IN d /\ ~(l INTER {x | x <= c} = {})) /\
            (i = l INTER {x | x <= c})) /\
           ((interval_lowerbound i = x) \/ (interval_upperbound i = x)))
          ==> l IN d /\
         ((interval_lowerbound l = x) \/ (interval_upperbound l = x))`` THENL
  [ALL_TAC, METIS_TAC [GSYM LEFT_EXISTS_AND_THM, SWAP_EXISTS_THM, MONO_EXISTS]],
   KNOW_TAC ``!l. (?i. ((l IN d /\ ~(l INTER {x | x >= c} = {})) /\
            (i = l INTER {x | x >= c})) /\
           ((interval_lowerbound i = x) \/ (interval_upperbound i = x)))
          ==> l IN d /\
         ((interval_lowerbound l = x) \/ (interval_upperbound l = x))`` THENL
  [ALL_TAC, METIS_TAC [GSYM LEFT_EXISTS_AND_THM, SWAP_EXISTS_THM, MONO_EXISTS]]] THEN
  (ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`]) THENL
  [KNOW_TAC ``!l. (l IN d /\ ~(l INTER {x | x <= c} = {})) /\
     ((interval_lowerbound (l INTER {x | x <= c}) = x) \/
      (interval_upperbound (l INTER {x | x <= c}) = x))
     ==> l IN d /\
         ((interval_lowerbound l = x) \/ (interval_upperbound l = x))`` THENL
  [ALL_TAC, METIS_TAC [UNWIND_THM2]] THEN SIMP_TAC std_ss [GSYM CONJ_ASSOC],
   KNOW_TAC ``!l. (l IN d /\ ~(l INTER {x | x >= c} = {})) /\
     ((interval_lowerbound (l INTER {x | x >= c}) = x) \/
      (interval_upperbound (l INTER {x | x >= c}) = x))
     ==> l IN d /\
         ((interval_lowerbound l = x) \/ (interval_upperbound l = x))`` THENL
  [ALL_TAC, METIS_TAC [UNWIND_THM2]] THEN SIMP_TAC std_ss [GSYM CONJ_ASSOC]] THEN
  (ONCE_REWRITE_TAC[IMP_CONJ] THEN
  FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
  MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN DISCH_TAC THEN
  ASM_SIMP_TAC std_ss [INTERVAL_SPLIT] THEN
  SUBGOAL_THEN
  ``(u:real) <= (v:real)`` ASSUME_TAC THENL
  [SIMP_TAC std_ss [GSYM INTERVAL_NE_EMPTY] THEN ASM_MESON_TAC[division_of],
   ALL_TAC] THEN
  REWRITE_TAC[INTERVAL_NE_EMPTY] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  ASM_SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_LOWERBOUND] THEN
  POP_ASSUM MP_TAC THEN REWRITE_TAC [min_def, max_def] THEN
  REPEAT (COND_CASES_TAC) THEN FULL_SIMP_TAC arith_ss [] THEN
  REPEAT STRIP_TAC THEN FULL_SIMP_TAC std_ss [REAL_LT_REFL]));

val DIVISION_POINTS_PSUBSET = store_thm ("DIVISION_POINTS_PSUBSET",
 ``!a b:real c d.
   d division_of interval[a,b] /\ a < b /\ a < c /\ c < b /\
   (?l. l IN d /\
   ((interval_lowerbound l = c) \/ (interval_upperbound l = c)))
   ==> division_points (interval[a,b] INTER {x | x <= c})
       {l INTER {x | x <= c} | l |
        l IN d /\ ~(l INTER {x | x <= c} = {})}
       PSUBSET division_points (interval[a,b]) d /\
       division_points (interval[a,b] INTER {x | x >= c})
       {l INTER {x | x >= c} | l |
        l IN d /\ ~(l INTER {x | x >= c} = {})}
       PSUBSET division_points (interval[a,b]) d``,
  REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC std_ss [PSUBSET_MEMBER, DIVISION_POINTS_SUBSET] THENL
  [EXISTS_TAC ``1:num,(interval_lowerbound l:real)``,
   EXISTS_TAC ``1:num,(interval_lowerbound l:real)``,
   EXISTS_TAC ``1:num,(interval_upperbound l:real)``,
   EXISTS_TAC ``1:num,(interval_upperbound l:real)``] THEN
  ASM_SIMP_TAC std_ss [division_points, IN_ELIM_PAIR_THM] THEN
  ASM_SIMP_TAC std_ss [INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND, REAL_LT_IMP_LE] THEN
  (CONJ_TAC THENL [ASM_MESON_TAC[], ALL_TAC]) THEN
  ASM_SIMP_TAC std_ss [INTERVAL_SPLIT, INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND,
   REAL_LT_IMP_LE] THEN
  ASM_SIMP_TAC std_ss [METIS [max_def, REAL_LT_IMP_LE] ``a < c ==> (max a c = c:real)``,
                       METIS [min_def, REAL_NOT_LE] ``c < b ==> (min b c = c:real)``] THEN
  ASM_SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_LOWERBOUND, REAL_LT_IMP_LE, COND_ID,
   METIS [] ``(a <= if p then x else y) <=> (if p then a <= x else a <= y)``,
   METIS [] ``(if p then x else y) <= a <=> (if p then x <= a else y <= a)``] THEN
  REWRITE_TAC[REAL_LT_REFL]);

(* ------------------------------------------------------------------------- *)
(* Preservation by divisions and tagged divisions.                           *)
(* ------------------------------------------------------------------------- *)

Theorem OPERATIVE_DIVISION :
    !op d a b f:(real->bool)->'a.
        monoidal op /\ operative op f /\ d division_of interval[a,b]
    ==> (iterate(op) d f = f(interval[a,b]))
Proof
  REPEAT GEN_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
  completeInduct_on
   `CARD (division_points (interval[a,b]:real->bool) d)` THEN
  REPEAT GEN_TAC THEN DISCH_TAC THEN FULL_SIMP_TAC std_ss [] THEN
  POP_ASSUM K_TAC THEN
  POP_ASSUM(fn th => REPEAT STRIP_TAC THEN MP_TAC th) THEN
  ASM_REWRITE_TAC[] THEN
   ASM_CASES_TAC ``content(interval[a:real,b]) = &0`` THENL
  [SUBGOAL_THEN ``iterate op d (f:(real->bool)->'a) = neutral op``
   (fn th => METIS_TAC[th, operative]) THEN
   MATCH_MP_TAC(SIMP_RULE std_ss [RIGHT_IMP_FORALL_THM, AND_IMP_INTRO]
   ITERATE_EQ_NEUTRAL) THEN
   UNDISCH_TAC ``d division_of interval [(a,b)]`` THEN DISCH_TAC THEN
   FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
   ASM_MESON_TAC[operative, DIVISION_OF_CONTENT_0],
   ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o REWRITE_RULE [GSYM CONTENT_LT_NZ]) THEN
  REWRITE_TAC[CONTENT_POS_LT_EQ] THEN STRIP_TAC THEN
  UNDISCH_TAC ``d division_of interval [(a,b)]`` THEN DISCH_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
  ASM_CASES_TAC ``division_points (interval[a,b]:real->bool) d = {}`` THENL
  [(* goal 1 (of 2) *)
   DISCH_THEN(K ALL_TAC) THEN
   SUBGOAL_THEN
   ``!i. i IN d
     ==> ?u v:real. (i = interval[u,v]) /\
         ((u = (a:real)) /\ (v = a) \/
          (u = (b:real)) /\ (v = b) \/
          (u = a) /\ (v = b))``
    (ASSUME_TAC) THENL
    [FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
     MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN DISCH_TAC THEN
     MAP_EVERY EXISTS_TAC [``u:real``, ``v:real``] THEN REWRITE_TAC[] THEN
     UNDISCH_TAC ``d division_of interval [(a,b)]`` THEN DISCH_TAC THEN
     FIRST_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
     ASM_REWRITE_TAC[] THEN
     DISCH_THEN(MP_TAC o SPEC ``interval[u:real,v]`` o CONJUNCT1) THEN
     ASM_REWRITE_TAC[INTERVAL_NE_EMPTY] THEN
     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (ASSUME_TAC o CONJUNCT1)) THEN
     ASM_REWRITE_TAC[SUBSET_INTERVAL] THEN STRIP_TAC THEN
     MATCH_MP_TAC(REAL_ARITH
     ``a <= u /\ u <= v /\ v <= b /\ ~(a < u /\ u < b \/ a < v /\ v < b:real)
       ==> (u = a) /\ (v = a) \/ (u = b) /\ (v = b) \/ (u = a) /\ (v = b)``) THEN
     ASM_REWRITE_TAC [] THEN DISCH_TAC THEN
     UNDISCH_TAC ``division_points (interval [(a,b)]) d = {}`` THEN DISCH_TAC THEN
     FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [EXTENSION]) THEN
     DISCH_THEN (MP_TAC o SIMP_RULE std_ss [division_points, NOT_IN_EMPTY, FORALL_PROD]) THEN
     SIMP_TAC std_ss [IN_ELIM_PAIR_THM] THEN EXISTS_TAC ``1:num`` THEN
     REWRITE_TAC [LESS_EQ_REFL] THEN SIMP_TAC std_ss [GSYM RIGHT_EXISTS_AND_THM] THEN
     SIMP_TAC std_ss [NOT_EXISTS_THM] THEN
     KNOW_TAC ``?(i :real -> bool)(p_2 :real).
      interval_lowerbound (interval [((a :real),(b :real))]) < p_2 /\
      p_2 < interval_upperbound (interval [(a,b)]) /\
      i IN (d :(real -> bool) -> bool) /\
      ((interval_lowerbound i = p_2) \/ (interval_upperbound i = p_2))`` THENL
     [ALL_TAC, METIS_TAC [SWAP_EXISTS_THM]] THEN
     EXISTS_TAC ``interval[u:real,v]`` THEN
     ASM_SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_LOWERBOUND, REAL_LT_IMP_LE] THEN
     KNOW_TAC ``~(!p_2:real. ~(a < p_2 /\ p_2 < b /\ ((u = p_2) \/ (v = p_2))))`` THENL
     [ALL_TAC, SIMP_TAC std_ss []] THEN
     DISCH_THEN(fn th =>
      MP_TAC(SPEC ``(u:real)`` th) THEN
      MP_TAC(SPEC ``(v:real)`` th)) THEN
     FIRST_X_ASSUM(DISJ_CASES_THEN MP_TAC) THEN REAL_ARITH_TAC,
     ALL_TAC] THEN
    SUBGOAL_THEN ``interval[a:real,b] IN d`` MP_TAC THENL
    [UNDISCH_TAC ``d division_of interval [(a,b)]`` THEN DISCH_TAC THEN
     FIRST_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
     ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN
     REWRITE_TAC[EXTENSION, IN_INTERVAL, IN_BIGUNION] THEN
     DISCH_THEN(MP_TAC o SPEC ``inv(&2) * (a + b:real)``) THEN
     MATCH_MP_TAC(TAUT `b /\ (a ==> c) ==> (a <=> b) ==> c`) THEN
     CONJ_TAC THENL
     [ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN REWRITE_TAC [GSYM real_div] THEN
      SIMP_TAC real_ss [REAL_LE_RDIV_EQ, REAL_LE_LDIV_EQ] THEN
      UNDISCH_TAC ``a < b:real`` THEN REAL_ARITH_TAC,
      ALL_TAC] THEN
     DISCH_THEN(X_CHOOSE_THEN ``i:real->bool``
     (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN
     UNDISCH_TAC ``!i. i IN d ==>
        ?u v:real. (i = interval [(u,v)]) /\
          ((u = a) /\ (v = a) \/ (u = b) /\ (v = b) \/ (u = a) /\ (v = b))`` THEN
     DISCH_THEN (MP_TAC o SPEC ``i:real->bool``) THEN
     ASM_REWRITE_TAC[] THEN SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
     MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN
     DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN
     SIMP_TAC std_ss [IN_INTERVAL] THEN
     SIMP_TAC std_ss [AND_IMP_INTRO, GSYM FORALL_AND_THM] THEN
     ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN REWRITE_TAC [GSYM real_div] THEN
      SIMP_TAC real_ss [REAL_LE_RDIV_EQ, REAL_LE_LDIV_EQ] THEN
     ASM_SIMP_TAC std_ss [REAL_ARITH
      ``a < b
       ==> (((u = a) /\ (v = a) \/ (u = b) /\ (v = b) \/ (u = a) /\ (v = b)) /\
       u * 2 <= (a + b) /\ (a + b) <= v * 2 <=>
       (u = a) /\ (v = b:real))``] THEN
     ASM_MESON_TAC[],
     ALL_TAC] THEN
    DISCH_THEN(fn th => ASSUME_TAC th THEN MP_TAC th) THEN
    DISCH_THEN(SUBST1_TAC o MATCH_MP (SET_RULE
    ``a IN d ==> (d = a INSERT (d DELETE a))``)) THEN
    ASM_SIMP_TAC std_ss [ITERATE_CLAUSES, FINITE_DELETE, IN_DELETE] THEN
    SUBGOAL_THEN
    ``iterate op (d DELETE interval[a,b]) (f:(real->bool)->'a) = neutral op``
     (fn th => METIS_TAC[th, monoidal]) THEN
    MATCH_MP_TAC(SIMP_RULE std_ss [RIGHT_IMP_FORALL_THM, AND_IMP_INTRO]
     ITERATE_EQ_NEUTRAL) THEN
    ASM_REWRITE_TAC[] THEN X_GEN_TAC ``l:real->bool`` THEN
    REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN
    SUBGOAL_THEN ``content(l:real->bool) = &0``
     (fn th => METIS_TAC[th, operative]) THEN
    UNDISCH_TAC ``!i. i IN d ==>
        ?u v:real. (i = interval [(u,v)]) /\
          ((u = a) /\ (v = a) \/ (u = b) /\ (v = b) \/ (u = a) /\ (v = b))`` THEN
    DISCH_THEN (MP_TAC o SPEC ``l:real->bool``) THEN
    ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN
    DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN
    UNDISCH_TAC ``~(interval[u:real,v] = interval[a,b])`` THEN
    ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
    REWRITE_TAC[] THEN DISCH_THEN(fn th => AP_TERM_TAC THEN MP_TAC th) THEN
    SIMP_TAC std_ss [CONS_11, PAIR_EQ, CONTENT_EQ_0] THEN
    REAL_ARITH_TAC, ALL_TAC] THEN
  KNOW_TAC ``
   (!(a' :real) (b' :real) (d' :(real -> bool) -> bool).
     (CARD (division_points (interval [(a',b')]) d') < CARD
     (division_points (interval [((a :real),(b :real))])
        (d :(real -> bool) -> bool))) ==>
     d' division_of interval [(a',b')] ==>
     ((f :(real -> bool) -> 'a) (interval [(a',b')]) =
      iterate (op :'a -> 'a -> 'a) d' f)) ==>
     (f (interval [(a,b)]) = iterate op d f)`` THENL
  [ALL_TAC, METIS_TAC []] THEN
  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
  GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV) [division_points] THEN
  SIMP_TAC std_ss [GSPECIFICATION, LEFT_IMP_EXISTS_THM, EXISTS_PROD] THEN
  MAP_EVERY X_GEN_TAC [``k:num``, ``c:real``] THEN
  ASM_SIMP_TAC std_ss [INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND, REAL_LT_IMP_LE] THEN
  DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
  MP_TAC(ISPECL [``a:real``, ``b:real``, ``c:real``, ``d:(real->bool)->bool``]
   DIVISION_POINTS_PSUBSET) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(CONJUNCTS_THEN
  (MP_TAC o MATCH_MP (SIMP_RULE std_ss [IMP_CONJ]
   (METIS [CARD_PSUBSET] ``!a b. a PSUBSET b /\ FINITE b ==>
                           CARD a < CARD b``)))) THEN
  MP_TAC(ISPECL [``d:(real->bool)->bool``, ``a:real``, ``b:real``, ``c:real``]
   DIVISION_SPLIT) THEN
  ASM_SIMP_TAC std_ss [DIVISION_POINTS_FINITE] THEN
  ASM_SIMP_TAC std_ss [INTERVAL_SPLIT] THEN
  KNOW_TAC ``(max a c = c:real) /\ (min b c = c:real)`` THENL
  [ CONJ_TAC >- (Suff `a <= c` >- METIS_TAC [REAL_MAX_ALT] \\
                 MATCH_MP_TAC REAL_LT_IMP_LE >> art []) \\
    Suff `c <= b` >- METIS_TAC [REAL_MIN_ALT] \\
    MATCH_MP_TAC REAL_LT_IMP_LE >> art [], STRIP_TAC ] THEN
  ASM_SIMP_TAC std_ss [] THEN POP_ASSUM K_TAC THEN POP_ASSUM K_TAC THEN
  MAP_EVERY ABBREV_TAC
  [``d1:(real->bool)->bool =
   {l INTER {x | x <= c} | l | l IN d /\ ~(l INTER {x | x <= c} = {})}``,
   ``d2:(real->bool)->bool =
   {l INTER {x | x >= c} | l | l IN d /\ ~(l INTER {x | x >= c} = {})}``,
   ``cb:real = c``,
   ``ca:real = c``] THEN
  STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC THEN
  DISCH_THEN(fn th =>
   MP_TAC(SPECL [``a:real``, ``cb:real``, ``d1:(real->bool)->bool``] th) THEN
   MP_TAC(SPECL [``ca:real``, ``b:real``, ``d2:(real->bool)->bool``] th)) THEN
  ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC EQ_TRANS THEN
  EXISTS_TAC ``op (iterate op d1 (f:(real->bool)->'a))
                  (iterate op d2 (f:(real->bool)->'a))`` THEN
  CONJ_TAC THENL
  [FIRST_ASSUM(MP_TAC o CONJUNCT2 o REWRITE_RULE [operative]) THEN
   DISCH_THEN(MP_TAC o SPECL [``a:real``, ``b:real``, ``c:real``]) THEN
   ASM_SIMP_TAC std_ss [INTERVAL_SPLIT] THEN
   KNOW_TAC ``(max a cb = cb:real) /\ (min b cb = cb:real)`` THENL
   [ CONJ_TAC >- (Suff `a <= cb` >- METIS_TAC [REAL_MAX_ALT] \\
                  MATCH_MP_TAC REAL_LT_IMP_LE >> art []) \\
     Suff `cb <= b` >- METIS_TAC [REAL_MIN_ALT] \\
     MATCH_MP_TAC REAL_LT_IMP_LE >> art [], STRIP_TAC ] THEN
   ASM_SIMP_TAC std_ss [],
   ALL_TAC] THEN
  MATCH_MP_TAC EQ_TRANS THEN
  EXISTS_TAC
  ``op (iterate op d (\l. f(l INTER {x | x <= c}):'a))
  (iterate op d (\l. f(l INTER {x:real | x >= c})))`` THEN
  CONJ_TAC THENL
  [ALL_TAC,
   ASM_SIMP_TAC std_ss [GSYM ITERATE_OP] THEN
   MATCH_MP_TAC(SIMP_RULE std_ss [RIGHT_IMP_FORALL_THM, AND_IMP_INTRO]
    ITERATE_EQ) THEN
   ASM_SIMP_TAC std_ss[MATCH_MP FORALL_IN_DIVISION
   (ASSUME ``d division_of interval[a:real,b]``)] THEN
   METIS_TAC[operative]] THEN
  ASM_SIMP_TAC std_ss [] THEN
  MAP_EVERY EXPAND_TAC ["d1", "d2"] THEN BINOP_TAC THEN
  (KNOW_TAC ``(iterate op d (\l. f (l INTER {x | x <= cb})) =
              iterate op d (f o (\l:real->bool. (l INTER {x | x <= cb})))) /\
             (iterate op d (\l. f (l INTER {x | x >= cb})) =
              iterate op d (f o (\l:real->bool. (l INTER {x | x >= cb}))))`` THENL
   [SIMP_TAC std_ss [o_DEF], DISCH_THEN (fn th => SIMP_TAC std_ss [th])]) THENL
 [KNOW_TAC ``iterate (op :'a -> 'a -> 'a)
  {l INTER {x | x <= (cb :real)} |
   l |
   l IN (d :(real -> bool) -> bool) /\
   l INTER {x | x <= cb} <> ({} :real -> bool)}
  (f :(real -> bool) -> 'a) =
             iterate (op :'a -> 'a -> 'a)
  {(\l. l INTER {x | x <= (cb :real)}) l |
   l |
   l IN (d :(real -> bool) -> bool) /\
   (\l. l INTER {x | x <= cb}) l <> ({} :real -> bool)}
  (f :(real -> bool) -> 'a)`` THENL
  [METIS_TAC [], DISCH_THEN (fn th => ONCE_REWRITE_TAC [th])],
  KNOW_TAC ``iterate (op :'a -> 'a -> 'a)
  {l INTER {x | x >= (cb :real)} |
   l |
   l IN (d :(real -> bool) -> bool) /\
   l INTER {x | x >= cb} <> ({} :real -> bool)}
  (f :(real -> bool) -> 'a) =
             iterate (op :'a -> 'a -> 'a)
  {(\l. l INTER {x | x >= (cb :real)}) l |
   l |
   l IN (d :(real -> bool) -> bool) /\
   (\l. l INTER {x | x >= cb}) l <> ({} :real -> bool)}
  (f :(real -> bool) -> 'a)`` THENL
  [METIS_TAC [], DISCH_THEN (fn th => ONCE_REWRITE_TAC [th])]] THEN
  MATCH_MP_TAC ITERATE_NONZERO_IMAGE_LEMMA THEN ASM_SIMP_TAC std_ss [] THEN
  (CONJ_TAC THENL [ASM_MESON_TAC[OPERATIVE_EMPTY], ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [``l:real->bool``, ``m:real->bool``] THEN STRIP_TAC THEN
  MATCH_MP_TAC(MESON[OPERATIVE_TRIVIAL]
  ``operative op f /\ (?a b. l = interval[a,b]) /\ (content l = &0)
    ==> (f l = neutral op)``) THEN
   ASM_SIMP_TAC std_ss [] THEN CONJ_TAC THENL
   [ALL_TAC, METIS_TAC[DIVISION_SPLIT_LEFT_INJ,
                           DIVISION_SPLIT_RIGHT_INJ]] THEN
   SUBGOAL_THEN ``?a b:real. m = interval[a,b]`` STRIP_ASSUME_TAC THENL
   [METIS_TAC[division_of], ALL_TAC] THEN
   ASM_SIMP_TAC std_ss [INTERVAL_SPLIT] THEN MESON_TAC[])
QED

val lemma = Q.prove (
   `(\(x,l). f l) = (f o SND)`,
    SIMP_TAC std_ss [FUN_EQ_THM, o_THM, FORALL_PROD]);

val OPERATIVE_TAGGED_DIVISION = store_thm ("OPERATIVE_TAGGED_DIVISION",
 ``!op d a b f:(real->bool)->'a.
    monoidal op /\ operative op f /\ d tagged_division_of interval[a,b]
    ==> (iterate(op) d (\(x,l). f l) = f(interval[a,b]))``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
  ``iterate op (IMAGE SND (d:(real#(real->bool)->bool))) f :'a`` THEN
  CONJ_TAC THENL
  [ALL_TAC,
   ASM_MESON_TAC[DIVISION_OF_TAGGED_DIVISION, OPERATIVE_DIVISION]] THEN
  REWRITE_TAC[lemma] THEN CONV_TAC SYM_CONV THEN
  KNOW_TAC ``monoidal (op:'a->'a->'a) /\ FINITE (d :real # (real -> bool) -> bool) /\
            (!x y.  x IN d /\ y IN d /\ ~(x = y) /\ (SND x = SND y)
                ==> ((f:(real -> bool) -> 'a) (SND x) = neutral op))`` THENL
  [ALL_TAC, METIS_TAC [RIGHT_IMP_FORALL_THM, AND_IMP_INTRO, ITERATE_IMAGE_NONZERO]] THEN
   ASM_SIMP_TAC std_ss [FORALL_PROD] THEN CONJ_TAC THENL
   [ASM_MESON_TAC[TAGGED_DIVISION_OF_FINITE], ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o REWRITE_RULE [TAGGED_DIVISION_OF]) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT1 o CONJUNCT2)) THEN
  DISCH_TAC THEN X_GEN_TAC ``x1:real`` THEN X_GEN_TAC ``k:real->bool`` THEN X_GEN_TAC ``x2:real`` THEN
  POP_ASSUM (MP_TAC o Q.SPECL [`x1:real`,`k:real->bool`,`x2:real`, `k:real->bool`]) THEN
  REWRITE_TAC[PAIR_EQ] THEN DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN
  ASM_SIMP_TAC std_ss [INTER_ACI] THEN
  ASM_MESON_TAC[CONTENT_EQ_0_INTERIOR, OPERATIVE_TRIVIAL,
   TAGGED_DIVISION_OF]);

(* ------------------------------------------------------------------------- *)
(* Additivity of content.                                                    *)
(* ------------------------------------------------------------------------- *)

val ADDITIVE_CONTENT_DIVISION = store_thm ("ADDITIVE_CONTENT_DIVISION",
 ``!d a b:real. d division_of interval[a,b]
    ==> (sum d content = content(interval[a,b]))``,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP
  (MATCH_MP (REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`]
   OPERATIVE_DIVISION) (CONJ MONOIDAL_REAL_ADD OPERATIVE_CONTENT))) THEN
  REWRITE_TAC[sum_def]);

val ADDITIVE_CONTENT_TAGGED_DIVISION = store_thm ("ADDITIVE_CONTENT_TAGGED_DIVISION",
 ``!d a b:real.
    d tagged_division_of interval[a,b]
    ==> (sum d (\(x,l). content l) = content(interval[a,b]))``,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP
  (MATCH_MP
  (REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`]
    OPERATIVE_TAGGED_DIVISION)
  (CONJ MONOIDAL_REAL_ADD OPERATIVE_CONTENT))) THEN
  REWRITE_TAC[sum_def]);

val SUBADDITIVE_CONTENT_DIVISION = store_thm ("SUBADDITIVE_CONTENT_DIVISION",
 ``!d s a b:real.
    d division_of s /\ s SUBSET interval[a,b]
    ==> sum d content <= content(interval[a,b])``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [``d:(real->bool)->bool``, ``a:real``, ``b:real``]
   PARTIAL_DIVISION_EXTEND_INTERVAL) THEN
  KNOW_TAC ``(d :(real -> bool) -> bool) division_of BIGUNION d /\
     BIGUNION d SUBSET interval [((a :real),(b :real))]`` THENL
  [REWRITE_TAC[BIGUNION_SUBSET] THEN
   ASM_MESON_TAC[division_of, DIVISION_OF_UNION_SELF, SUBSET_TRANS],
   DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
   DISCH_THEN(X_CHOOSE_THEN ``p:(real->bool)->bool`` STRIP_ASSUME_TAC) THEN
   MATCH_MP_TAC REAL_LE_TRANS THEN
   EXISTS_TAC ``sum (p:(real->bool)->bool) content`` THEN CONJ_TAC THENL
   [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
    ASM_MESON_TAC [division_of, CONTENT_POS_LE, IN_DIFF],
    ASM_MESON_TAC[ADDITIVE_CONTENT_DIVISION, REAL_LE_REFL]]]);

(* ------------------------------------------------------------------------- *)
(* Finally, the integral of a constant!                                      *)
(* ------------------------------------------------------------------------- *)

val HAS_INTEGRAL_CONST = store_thm ("HAS_INTEGRAL_CONST",
 ``!a b:real c:real.
  ((\x. c) has_integral (content(interval[a,b]) * c)) (interval[a,b])``,
  REWRITE_TAC[has_integral] THEN REPEAT STRIP_TAC THEN
  EXISTS_TAC ``\x:real. ball(x,&1)`` THEN REWRITE_TAC[GAUGE_TRIVIAL] THEN
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
  FIRST_X_ASSUM(fn th =>
   ONCE_REWRITE_TAC[GSYM(MATCH_MP ADDITIVE_CONTENT_TAGGED_DIVISION th)]) THEN
  KNOW_TAC ``(abs
      (sum (p :real # (real -> bool) -> bool)
         (\((x :real),(k :real -> bool)). content k * (c :real)) -
       sum p (\((x :real),(l :real -> bool)). content l) * c) = (0:real))`` THENL
  [ALL_TAC, METIS_TAC []] THEN SIMP_TAC std_ss [ABS_ZERO, REAL_SUB_0] THEN
  REWRITE_TAC [SET_RULE `` (\(x,k). content k) = (\(x,k). (\p. content (SND p)) (x,k))``] THEN
  REWRITE_TAC [SET_RULE `` (\(x,k). content k * c) =
               (\(x,k). (\k. content (SND k)  * c) (x,k))``] THEN
  REWRITE_TAC [GSYM LAMBDA_PROD] THEN SIMP_TAC std_ss [SUM_RMUL]);

val INTEGRABLE_CONST = store_thm ("INTEGRABLE_CONST",
 ``!a b:real c:real. (\x. c) integrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[integrable_on] THEN
  EXISTS_TAC ``content(interval[a:real,b]) * c:real`` THEN
  REWRITE_TAC[HAS_INTEGRAL_CONST]);

val INTEGRAL_CONST = store_thm ("INTEGRAL_CONST",
 ``!a b c. integral (interval[a,b]) (\x. c) = content(interval[a,b]) * c``,
  REPEAT GEN_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN
  REWRITE_TAC[HAS_INTEGRAL_CONST]);

(* ------------------------------------------------------------------------- *)
(* Bounds on the norm of Riemann sums and the integral itself.               *)
(* ------------------------------------------------------------------------- *)

val DSUM_BOUND = store_thm ("DSUM_BOUND",
 ``!p a b:real c:real e.
       p division_of interval[a,b] /\ abs (c) <= e
       ==> abs (sum p (\l. content l * c)) <= e * content(interval[a,b])``,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
  W(MP_TAC o PART_MATCH (lhand o rand) SUM_ABS o lhand o snd) THEN
  ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC(REAL_ARITH
   ``y <= e ==> x <= y ==> x <= e:real``) THEN
  SIMP_TAC std_ss [LAMBDA_PROD, ABS_MUL] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC ``sum p (\k:real->bool. content k * e)`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC std_ss [FORALL_PROD] THEN
    X_GEN_TAC ``l:real->bool`` THEN DISCH_TAC THEN
    MATCH_MP_TAC REAL_LE_MUL2 THEN SIMP_TAC std_ss [REAL_ABS_POS, ABS_POS] THEN
    ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC(REAL_ARITH ``&0 <= x ==> abs(x) <= x:real``) THEN
    ASM_MESON_TAC[DIVISION_OF, CONTENT_POS_LE],
    SIMP_TAC std_ss [SUM_RMUL, ETA_AX] THEN
    ASM_MESON_TAC[ADDITIVE_CONTENT_DIVISION, REAL_LE_REFL, REAL_MUL_SYM]]);

val RSUM_BOUND = store_thm ("RSUM_BOUND",
 ``!p a b f:real->real e.
       p tagged_division_of interval[a,b] /\
       (!x. x IN interval[a,b] ==> abs(f x) <= e)
       ==> abs(sum p (\(x,k). content k * f x))
            <= e * content(interval[a,b])``,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
  W(MP_TAC o PART_MATCH (lhand o rand) SUM_ABS o lhand o snd) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH
   ``y <= e ==> x <= y ==> x <= e:real``) THEN
  SIMP_TAC std_ss [LAMBDA_PROD, ABS_MUL] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC ``sum p (\(x:real,k:real->bool). content k * e)`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC std_ss [FORALL_PROD] THEN
    MAP_EVERY X_GEN_TAC [``x:real``, ``l:real->bool``] THEN DISCH_TAC THEN
    MATCH_MP_TAC REAL_LE_MUL2 THEN SIMP_TAC std_ss [REAL_ABS_POS, ABS_POS] THEN
    CONJ_TAC THENL
     [ASM_MESON_TAC[TAGGED_DIVISION_OF, CONTENT_POS_LE, ABS_REFL,
                    REAL_LE_REFL],
      ASM_MESON_TAC[TAG_IN_INTERVAL]],
    FIRST_ASSUM(fn th => REWRITE_TAC
     [GSYM(MATCH_MP ADDITIVE_CONTENT_TAGGED_DIVISION th)]) THEN
    SIMP_TAC std_ss [GSYM SUM_LMUL, LAMBDA_PROD] THEN
    SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_MUL_SYM, REAL_LE_REFL]]);

val RSUM_DIFF_BOUND = store_thm ("RSUM_DIFF_BOUND",
 ``!e p a b f g:real->real.
       p tagged_division_of interval[a,b] /\
       (!x. x IN interval[a,b] ==> abs(f x - g x) <= e)
       ==> abs(sum p (\(x,k). content k * f x) -
               sum p (\(x,k). content k * g x))
           <= e * content(interval[a,b])``,
  REPEAT STRIP_TAC THEN
  UNDISCH_TAC ``p tagged_division_of interval [(a,b)]`` THEN DISCH_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC
   ``abs(sum p (\(x,k).
      content(k:real->bool) * ((f:real->real) x - g x)))`` THEN
  CONJ_TAC THENL
   [ASM_SIMP_TAC std_ss [GSYM SUM_SUB, REAL_SUB_LDISTRIB] THEN
    SIMP_TAC std_ss [LAMBDA_PROD, REAL_LE_REFL],
    ASM_SIMP_TAC std_ss [RSUM_BOUND]]);

val lemma = Q.prove (
   `abs(s) <= B ==> ~(abs(s - i) < abs(i) - B:real)`,
  MATCH_MP_TAC (REAL_ARITH ``n1 <= n + n2 ==> n <= B:real ==> ~(n2 < n1 - B)``) THEN
    ONCE_REWRITE_TAC[ABS_SUB] THEN REWRITE_TAC[ABS_TRIANGLE_SUB]);

val HAS_INTEGRAL_BOUND = store_thm ("HAS_INTEGRAL_BOUND",
 ``!f:real->real a b i B.
        &0 <= B /\
        (f has_integral i) (interval[a,b]) /\
        (!x. x IN interval[a,b] ==> abs(f x) <= B)
        ==> abs i <= B * content(interval[a,b])``,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC ``&0 < content(interval[a:real,b])`` THENL
   [ALL_TAC,
    SUBGOAL_THEN ``i:real = 0`` SUBST1_TAC THEN
    ASM_SIMP_TAC std_ss [REAL_LE_MUL, ABS_0, CONTENT_POS_LE] THEN
    ASM_MESON_TAC[HAS_INTEGRAL_NULL_EQ, CONTENT_LT_NZ]] THEN
  ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
  UNDISCH_TAC ``(f has_integral i) (interval [(a,b)])`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [has_integral]) THEN
  DISCH_THEN(MP_TAC o SPEC
    ``abs(i:real) - B * content(interval[a:real,b])``) THEN
  ASM_REWRITE_TAC[REAL_SUB_LT] THEN
  DISCH_THEN(X_CHOOSE_THEN ``d:real->real->bool`` STRIP_ASSUME_TAC) THEN
  MP_TAC(SPECL [``d:real->real->bool``, ``a:real``, ``b:real``]
        FINE_DIVISION_EXISTS) THEN
  ASM_REWRITE_TAC[] THEN DISCH_THEN
   (X_CHOOSE_THEN ``p:(real#(real->bool)->bool)`` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``p:(real#(real->bool)->bool)``) THEN
  METIS_TAC[lemma, RSUM_BOUND]);

(* ------------------------------------------------------------------------- *)
(* Similar theorems about relationship among components.                     *)
(* ------------------------------------------------------------------------- *)

val RSUM_COMPONENT_LE = store_thm ("RSUM_COMPONENT_LE",
 ``!p a b f:real->real g:real->real.
       p tagged_division_of interval[a,b] /\
       (!x. x IN interval[a,b] ==> (f x) <= (g x))
       ==> sum p (\(x,k). content k * f x) <=
           sum p (\(x,k). content k * g x)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_LE THEN
  ASM_SIMP_TAC std_ss [FORALL_PROD] THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
  REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  UNDISCH_TAC `` p tagged_division_of interval [(a,b)]`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [TAGGED_DIVISION_OF]) THEN
  ASM_REWRITE_TAC [] THEN STRIP_TAC THEN POP_ASSUM MP_TAC THEN
  POP_ASSUM MP_TAC THEN
  POP_ASSUM (MP_TAC o Q.SPECL [`p_1:real`,`p_2:real->bool`]) THEN
  ASM_REWRITE_TAC [SUBSET_DEF] THEN REPEAT STRIP_TAC THEN
  ASM_REWRITE_TAC [] THEN Cases_on `content (interval [(a',b')]) =  0` THENL
  [ASM_REWRITE_TAC [] THEN REAL_ARITH_TAC, ALL_TAC] THEN
  MP_TAC(SPECL [``a':real``, ``b':real``] CONTENT_POS_LE) THEN
  GEN_REWR_TAC LAND_CONV [REAL_LE_LT] THEN
  GEN_REWR_TAC (LAND_CONV o RAND_CONV) [EQ_SYM_EQ] THEN ASM_REWRITE_TAC [] THEN
  DISCH_TAC THEN ASM_SIMP_TAC std_ss [REAL_LE_LMUL]);

val HAS_INTEGRAL_COMPONENT_LE = store_thm ("HAS_INTEGRAL_COMPONENT_LE",
 ``!f:real->real g:real->real s i j.
        (f has_integral i) s /\ (g has_integral j) s /\
        (!x. x IN s ==> (f x) <= (g x))
        ==> i <= j``,
  SUBGOAL_THEN
   ``!f:real->real g:real->real a b i j.
        (f has_integral i) (interval[a,b]) /\
        (g has_integral j) (interval[a,b]) /\
        (!x. x IN interval[a,b] ==> (f x) <= (g x))
        ==> i <= j``
  ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN
    MATCH_MP_TAC(REAL_ARITH ``~(&0 < i - j) ==> i <= j:real``) THEN DISCH_TAC THEN
    UNDISCH_TAC ``((f :real -> real) has_integral (i :real))
            (interval [((a :real),(b :real))])`` THEN DISCH_TAC THEN
    UNDISCH_TAC ``((g :real -> real) has_integral (j :real))
            (interval [((a :real),(b :real))])`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``((i:real) - (j:real)) / &3`` o
       REWRITE_RULE [has_integral]) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``((i:real) - (j:real)) / &3`` o
       REWRITE_RULE [has_integral]) THEN
    ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT] THEN
    DISCH_THEN(X_CHOOSE_THEN ``d1:real->real->bool`` STRIP_ASSUME_TAC) THEN
    X_GEN_TAC ``d2:real->real->bool`` THEN CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN
    SUBGOAL_THEN ``?((p:real#(real->bool)->bool)). p tagged_division_of interval[a:real,b] /\
                      d1 FINE p /\ d2 FINE p``
    STRIP_ASSUME_TAC THENL
     [SIMP_TAC std_ss [GSYM FINE_INTER] THEN MATCH_MP_TAC FINE_DIVISION_EXISTS THEN
      ASM_SIMP_TAC std_ss [GAUGE_INTER], ALL_TAC] THEN
    REPEAT
     (FIRST_X_ASSUM(MP_TAC o SPEC ``p:real#(real->bool)->bool``) THEN
      ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN
      ASM_SIMP_TAC std_ss []) THEN
    SUBGOAL_THEN
     ``sum p (\(x,l:real->bool). content l * (f:real->real) x) <=
       sum p (\(x,l). content l * (g:real->real) x)``
    MP_TAC THENL
     [MATCH_MP_TAC RSUM_COMPONENT_LE THEN METIS_TAC[],
      UNDISCH_TAC ``&0 < (i:real) - (j:real)`` THEN
      SPEC_TAC(``sum p (\(x:real,l:real->bool).
                                content l * (f x):real)``,
               ``fs:real``) THEN
      SPEC_TAC(``sum p (\(x:real,l:real->bool).
                                content l * (g x):real)``,
               ``gs:real``) THEN
      SIMP_TAC std_ss [REAL_LE_RDIV_EQ, REAL_ARITH ``0 < 3:real``] THEN
      REAL_ARITH_TAC], ALL_TAC] THEN
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[has_integral_alt] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[], ALL_TAC] THEN
  STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
  UNDISCH_TAC ``!e. 0 < e ==> ?B. 0 < B /\
              !a b. ball (0,B) SUBSET interval [(a,b)] ==>
                ?z. ((\x. if x IN s then g x else 0) has_integral z)
                    (interval [(a,b)]) /\ abs (z - j) < e:real`` THEN
  UNDISCH_TAC ``!e. 0 < e ==> ?B. 0 < B /\
              !a b. ball (0,B) SUBSET interval [(a,b)] ==>
                ?z. ((\x. if x IN s then f x else 0) has_integral z)
                    (interval [(a,b)]) /\ abs (z - i) < e:real`` THEN
  DISCH_TAC THEN DISCH_TAC THEN
  UNDISCH_TAC ``!x:real. x IN s ==> f x <= (g x):real`` THEN
  REPEAT (FIRST_X_ASSUM(MP_TAC o SPEC ``((i:real) - (j:real)) / &2``)) THEN
  ASM_SIMP_TAC std_ss [REAL_HALF, REAL_SUB_LT] THEN
  DISCH_THEN(X_CHOOSE_THEN ``B1:real`` STRIP_ASSUME_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN ``B2:real`` STRIP_ASSUME_TAC) THEN
  CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN
  MP_TAC(ISPEC
   ``ball(0,B1) UNION ball(0:real,B2)``
   BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
  SIMP_TAC std_ss [BOUNDED_UNION, BOUNDED_BALL, UNION_SUBSET, NOT_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN REWRITE_TAC [GSYM DE_MORGAN_THM] THEN
  DISCH_THEN(CONJUNCTS_THEN(ANTE_RES_THEN MP_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN ``w:real`` STRIP_ASSUME_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN ``z:real`` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN ``(z:real) <= (w:real)`` MP_TAC THENL
   [FIRST_X_ASSUM MATCH_MP_TAC THEN
    MAP_EVERY EXISTS_TAC
     [``(\x. if x IN s then f x else 0):real->real``,
      ``(\x. if x IN s then g x else 0):real->real``,
      ``a:real``, ``b:real``] THEN
    METIS_TAC[REAL_LE_REFL],
    UNDISCH_TAC ``abs (z - i) < (i - j) / 2:real`` THEN
    UNDISCH_TAC ``abs (w - j) < (i - j) / 2:real`` THEN
    UNDISCH_TAC ``j < i:real`` THEN
    REWRITE_TAC [GSYM REAL_NOT_LE] THEN
    SIMP_TAC std_ss [REAL_LE_LDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
    REAL_ARITH_TAC]);

val INTEGRAL_COMPONENT_LE = store_thm ("INTEGRAL_COMPONENT_LE",
 ``!f:real->real g:real->real s.
        f integrable_on s /\ g integrable_on s /\
        (!x. x IN s ==> (f x) <= (g x))
        ==> (integral s f) <= (integral s g)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LE THEN
  ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);

val HAS_INTEGRAL_DROP_LE = store_thm ("HAS_INTEGRAL_DROP_LE",
 ``!f:real->real g:real->real s i j.
        (f has_integral i) s /\ (g has_integral j) s /\
        (!x. x IN s ==> (f x) <= (g x))
        ==> i <= j``,
  REWRITE_TAC[HAS_INTEGRAL_COMPONENT_LE]);

val INTEGRAL_DROP_LE = store_thm ("INTEGRAL_DROP_LE",
 ``!f:real->real g:real->real s.
        f integrable_on s /\ g integrable_on s /\
        (!x. x IN s ==> (f x) <= (g x))
        ==> (integral s f) <= (integral s g)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_DROP_LE THEN
  ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);

val HAS_INTEGRAL_COMPONENT_POS = store_thm ("HAS_INTEGRAL_COMPONENT_POS",
 ``!f:real->real s i.
        (f has_integral i) s /\
        (!x. x IN s ==> &0 <= (f x))
        ==> &0 <= i``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [``(\x. 0):real->real``, ``f:real->real``,
                 ``s:real->bool``, ``0:real``,
                 ``i:real``] HAS_INTEGRAL_COMPONENT_LE) THEN
  ASM_SIMP_TAC std_ss [HAS_INTEGRAL_0]);

val INTEGRAL_COMPONENT_POS = store_thm ("INTEGRAL_COMPONENT_POS",
 ``!f:real->real s.
        f integrable_on s /\
        (!x. x IN s ==> &0 <= (f x))
        ==> &0 <= (integral s f)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_POS THEN
  ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);

val HAS_INTEGRAL_DROP_POS = store_thm ("HAS_INTEGRAL_DROP_POS",
 ``!f:real->real s i.
        (f has_integral i) s /\
        (!x. x IN s ==> &0 <= (f x))
        ==> &0 <= i``,
  REWRITE_TAC [HAS_INTEGRAL_COMPONENT_POS]);

val INTEGRAL_DROP_POS = store_thm ("INTEGRAL_DROP_POS",
 ``!f:real->real s.
        f integrable_on s /\
        (!x. x IN s ==> &0 <= (f x))
        ==> &0 <= (integral s f)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_DROP_POS THEN
  ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);

val HAS_INTEGRAL_COMPONENT_NEG = store_thm ("HAS_INTEGRAL_COMPONENT_NEG",
 ``!f:real->real s i.
        (f has_integral i) s /\
        (!x. x IN s ==> (f x) <= &0)
        ==> i <= &0``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [``f:real->real``, ``(\x. 0):real->real``,
                 ``s:real->bool``, ``i:real``, ``0:real``]
                 HAS_INTEGRAL_COMPONENT_LE) THEN
  ASM_SIMP_TAC std_ss [HAS_INTEGRAL_0]);

val HAS_INTEGRAL_DROP_NEG = store_thm ("HAS_INTEGRAL_DROP_NEG",
 ``!f:real->real s i.
        (f has_integral i) s /\
        (!x. x IN s ==> (f x) <= &0)
        ==> i <= &0``,
  REWRITE_TAC [HAS_INTEGRAL_COMPONENT_NEG]);

val HAS_INTEGRAL_COMPONENT_LBOUND = store_thm ("HAS_INTEGRAL_COMPONENT_LBOUND",
 ``!f:real->real a b i.
        (f has_integral i) (interval[a,b]) /\
        (!x. x IN interval[a,b] ==> B <= f(x))
        ==> B * content(interval[a,b]) <= i``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [``(\x. @f. f = B):real->real``, ``f:real->real``,
                 ``interval[a:real,b]``,
                 ``content(interval[a:real,b]) * (@f. f = B):real``,
                 ``i:real``] HAS_INTEGRAL_COMPONENT_LE) THEN
  ASM_SIMP_TAC std_ss [HAS_INTEGRAL_CONST] THEN
  SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_MUL_SYM]);

val HAS_INTEGRAL_COMPONENT_UBOUND = store_thm ("HAS_INTEGRAL_COMPONENT_UBOUND",
 ``!f:real->real a b i.
        (f has_integral i) (interval[a,b]) /\
        (!x. x IN interval[a,b] ==> f(x) <= B)
        ==> i <= B * content(interval[a,b])``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [``f:real->real``, ``(\x. @f. f = B):real->real``,
                 ``interval[a:real,b]``, ``i:real``,
                 ``content(interval[a:real,b]) * (@f. f = B):real``]
                HAS_INTEGRAL_COMPONENT_LE) THEN
  ASM_SIMP_TAC std_ss [HAS_INTEGRAL_CONST] THEN
  SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_MUL_SYM]);

val INTEGRAL_COMPONENT_LBOUND = store_thm ("INTEGRAL_COMPONENT_LBOUND",
 ``!f:real->real a b.
        f integrable_on interval[a,b] /\
        (!x. x IN interval[a,b] ==> B <= f(x))
        ==> B * content(interval[a,b]) <= (integral(interval[a,b]) f)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LBOUND THEN
  EXISTS_TAC ``f:real->real`` THEN
  ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]);

val INTEGRAL_COMPONENT_UBOUND = store_thm ("INTEGRAL_COMPONENT_UBOUND",
 ``!f:real->real a b.
        f integrable_on interval[a,b] /\
        (!x. x IN interval[a,b] ==> f(x) <= B)
        ==> (integral(interval[a,b]) f) <= B * content(interval[a,b])``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_UBOUND THEN
  EXISTS_TAC ``f:real->real`` THEN
  ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]);

(* ------------------------------------------------------------------------- *)
(* Uniform limit of integrable functions is integrable.                      *)
(* ------------------------------------------------------------------------- *)

val lemma = prove (
  ``x:real <= abs(a + b) + c ==> x <= abs(a) + abs(b) + c``,
    MESON_TAC[REAL_ADD_ASSOC, REAL_ADD_SYM, ABS_TRIANGLE, REAL_LE_TRANS, REAL_LE_RADD]);

val lemma12 = prove (
 ``(abs(s2 - s1) <= e / &2:real /\
    abs(s1 - i1) < e / &4:real /\ abs(s2 - i2) < e / &4:real
    ==> abs(i1 - i2) < e) /\
   (abs(sf - sg) <= e / &3:real
    ==> abs(i - s) < e / &3:real ==> abs(sg - i) < e / &3:real ==> abs(sf - s) < e)``,
    CONJ_TAC THENL
     [REWRITE_TAC[CONJ_ASSOC] THEN
      GEN_REWR_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [ABS_SUB] THEN
      SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_LE_RDIV_EQ,
       REAL_ARITH ``0 < 2:real``, REAL_ARITH ``0 < 4:real``] THEN
      REAL_ARITH_TAC,
      SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_LE_RDIV_EQ,
       REAL_ARITH ``0 < 3:real``] THEN REAL_ARITH_TAC]);

val lemma1 = prove (
 ``(abs(s2 - s1) <= e / &2:real /\
    abs(s1 - i1) < e / &4:real /\ abs(s2 - i2) < e / &4:real
    ==> abs(i1 - i2) < e)``,
 REWRITE_TAC [lemma12]);

val lemma2 = prove (
  ``(abs(sf - sg) <= e / &3:real
    ==> abs(i - s) < e / &3:real ==> abs(sg - i) < e / &3:real ==> abs(sf - s) < e)``,
  REWRITE_TAC [lemma12]);

val ABS_TRIANGLE_LE = store_thm ("ABS_TRIANGLE_LE",
 ``!x y. abs(x) + abs(y) <= e ==> abs(x + y) <= e:real``,
  METIS_TAC[REAL_LE_TRANS, ABS_TRIANGLE]);

val INTEGRABLE_UNIFORM_LIMIT = store_thm ("INTEGRABLE_UNIFORM_LIMIT",
 ``!f a b. (!e. &0 < e
                ==> ?g. (!x. x IN interval[a,b] ==> abs(f x - g x) <= e) /\
                        g integrable_on interval[a,b] )
           ==> (f:real->real) integrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC ``&0 < content(interval[a:real,b])`` THENL
   [ALL_TAC,
    ASM_MESON_TAC[HAS_INTEGRAL_NULL, CONTENT_LT_NZ, integrable_on]] THEN
  FIRST_X_ASSUM(MP_TAC o GEN ``n:num`` o SPEC ``inv(&n + &1:real)``) THEN
  SIMP_TAC std_ss [REAL_LT_INV_EQ, METIS
   [ADD1, LESS_0, REAL_OF_NUM_ADD, REAL_LT] ``&0 < &n + &1:real``] THEN
  SIMP_TAC std_ss [FORALL_AND_THM, SKOLEM_THM, integrable_on] THEN
  DISCH_THEN(X_CHOOSE_THEN ``g:num->real->real`` (CONJUNCTS_THEN2
   ASSUME_TAC (X_CHOOSE_TAC ``i:num->real``))) THEN
  SUBGOAL_THEN ``cauchy(i:num->real)`` MP_TAC THENL
   [REWRITE_TAC[cauchy] THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
    MP_TAC(SPEC ``e / &4 / content(interval[a:real,b])``
        REAL_ARCH_INV) THEN
    ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT] THEN
    DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN
    EXISTS_TAC ``N:num`` THEN POP_ASSUM MP_TAC THEN STRIP_TAC THEN
    MAP_EVERY X_GEN_TAC [``m:num``, ``n:num``] THEN REWRITE_TAC[GE] THEN
    STRIP_TAC THEN
    UNDISCH_TAC ``!n:num. (g n has_integral i n) (interval [(a,b)])`` THEN
    DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [has_integral]) THEN
    KNOW_TAC ``(!(e :real)(n :num).
       (0 :real) < e ==>
       ?(d :real -> real -> bool).
         (gauge d :bool) /\
         !(p :real # (real -> bool) -> bool).
           p tagged_division_of interval [((a :real),(b :real))] /\
           d FINE p ==>
           abs
             (sum p
                (\((x :real),(k :real -> bool)).
                   content k * (g :num -> real -> real) n x) -
              (i :num -> real) n) < e) ==>
    (dist (i (m :num),i (n :num)) :real) < (e :real)`` THENL
    [ALL_TAC, METIS_TAC [SWAP_FORALL_THM]] THEN
    DISCH_THEN(MP_TAC o SPEC ``e / &4:real``) THEN
    ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT] THEN
    DISCH_THEN(fn th => MP_TAC(SPEC ``m:num`` th) THEN
      MP_TAC(SPEC ``n:num`` th)) THEN
    DISCH_THEN(X_CHOOSE_THEN ``gn:real->real->bool`` STRIP_ASSUME_TAC) THEN
    DISCH_THEN(X_CHOOSE_THEN ``gm:real->real->bool`` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPECL [``(\x. gm(x) INTER gn(x)):real->real->bool``,
                   ``a:real``, ``b:real``] FINE_DIVISION_EXISTS) THEN
    ASM_SIMP_TAC std_ss [GAUGE_INTER, LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC ``p:(real#(real->bool))->bool`` THEN STRIP_TAC THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC ``p:(real#(real->bool))->bool``)) THEN
    FIRST_ASSUM(fn th => REWRITE_TAC[CONV_RULE(REWR_CONV FINE_INTER) th]) THEN
    SUBGOAL_THEN ``abs(sum p (\(x,k:real->bool). content k * g (n:num) x) -
                       sum p (\(x:real,k). content k * g m x :real))
                  <= e / &2:real`` MP_TAC THENL
    [ALL_TAC, ASM_REWRITE_TAC[dist] THEN MESON_TAC[lemma1]] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC ``&2 / &N * content(interval[a:real,b])`` THEN CONJ_TAC THENL
     [MATCH_MP_TAC RSUM_DIFF_BOUND,
      ASM_SIMP_TAC std_ss [GSYM REAL_LE_RDIV_EQ] THEN
      KNOW_TAC ``0 < &N:real`` THENL
          [METIS_TAC [REAL_LT, ZERO_LESS_EQ, LESS_OR_EQ], DISCH_TAC] THEN
      GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF] THEN
      REWRITE_TAC [real_div] THEN
          REWRITE_TAC [REAL_ARITH ``a * b * c * d = a * (b * d) * c:real``] THEN
      SIMP_TAC std_ss [GSYM REAL_INV_MUL, REAL_ARITH ``0 <> 2:real``] THEN
      REWRITE_TAC [REAL_ARITH ``2 * 2 = 4:real``] THEN REWRITE_TAC [GSYM real_div] THEN
      MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``inv (&N) + inv (&N:real)`` THEN
      CONJ_TAC THENL [SIMP_TAC std_ss [REAL_DOUBLE, GSYM real_div, REAL_LE_REFL],
      MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC [REAL_LE_LT]]] THEN
    ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(fn th => MP_TAC(SPECL [``n:num``, ``x:real``] th) THEN
      MP_TAC(SPECL [``m:num``, ``x:real``] th)) THEN
    ASM_REWRITE_TAC[AND_IMP_INTRO] THEN
    GEN_REWR_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [ABS_SUB] THEN
    DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_ADD2) THEN
    DISCH_THEN(MP_TAC o MATCH_MP ABS_TRIANGLE_LE) THEN
    KNOW_TAC ``!u v a b x. (u = v) /\ a <= inv(x) /\ b <= inv(x) ==>
                                u <= a + b ==> v <= &2 / x:real`` THENL
    [REPEAT GEN_TAC THEN STRIP_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
     EXISTS_TAC ``a' + b':real`` THEN UNDISCH_TAC ``u = v:real`` THEN
     GEN_REWR_TAC LAND_CONV [EQ_SYM_EQ] THEN DISCH_TAC THEN
     ASM_SIMP_TAC std_ss [EQ_SYM_EQ, real_div, GSYM REAL_DOUBLE] THEN
     MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_SIMP_TAC std_ss [],
     DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC] THEN
    CONJ_TAC THENL [AP_TERM_TAC THEN REAL_ARITH_TAC, ALL_TAC] THEN
    CONJ_TAC THEN MATCH_MP_TAC REAL_LE_INV2 THEN
    ASM_SIMP_TAC arith_ss [REAL_OF_NUM_ADD, REAL_OF_NUM_LE, REAL_LT],
    ALL_TAC] THEN
  REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN
  DISCH_THEN (X_CHOOSE_TAC ``s:real``) THEN EXISTS_TAC ``s:real`` THEN
  REWRITE_TAC[has_integral] THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &3:real`` o REWRITE_RULE [LIM_SEQUENTIALLY]) THEN
  ASM_SIMP_TAC arith_ss [dist, REAL_LT_DIV, REAL_LT] THEN
  DISCH_THEN(X_CHOOSE_TAC ``N1:num``) THEN
  MP_TAC(SPEC ``e / &3 / content(interval[a:real,b])`` REAL_ARCH_INV) THEN
  ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT] THEN
  DISCH_THEN(X_CHOOSE_THEN ``N2:num`` STRIP_ASSUME_TAC) THEN
  UNDISCH_TAC ``!n:num. (g n has_integral i n) (interval [(a,b)])`` THEN
  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [has_integral]) THEN
  DISCH_THEN(MP_TAC o SPECL [``N1 + N2:num``, ``e / &3:real``]) THEN
  ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT] THEN
  DISCH_THEN (X_CHOOSE_TAC ``g:real->real->bool``) THEN
  EXISTS_TAC ``g:real->real->bool`` THEN POP_ASSUM MP_TAC THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  X_GEN_TAC ``p:real#(real->bool)->bool`` THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``p:real#(real->bool)->bool``) THEN
  ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ARITH_PROVE ``N1:num <= N1 + N2``)) THEN
  MATCH_MP_TAC lemma2 THEN MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC ``inv(&(N1 + N2) + &1) * content(interval[a:real,b])`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC RSUM_DIFF_BOUND THEN ASM_REWRITE_TAC[], ALL_TAC] THEN
  ASM_SIMP_TAC std_ss [GSYM REAL_LE_RDIV_EQ] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
   ``x < a ==> y <= x ==> y <= a:real``)) THEN
  MATCH_MP_TAC REAL_LE_INV2 THEN
  ASM_SIMP_TAC arith_ss [REAL_OF_NUM_ADD, REAL_OF_NUM_LE, REAL_LT]);

(* ------------------------------------------------------------------------- *)
(* Negligible sets.                                                          *)
(* ------------------------------------------------------------------------- *)

val negligible = new_definition ("negligible",
 ``negligible s <=> !a b. (indicator s has_integral (0)) (interval[a,b])``);

(* ------------------------------------------------------------------------- *)
(* Negligibility of hyperplane.                                              *)
(* ------------------------------------------------------------------------- *)

val SUM_NONZERO_IMAGE_LEMMA = store_thm ("SUM_NONZERO_IMAGE_LEMMA",
 ``!s f:'a->'b g:'b->real a.
        FINITE s /\ (g(a) = 0) /\
        (!x y. x IN s /\ y IN s /\ (f x = f y) /\ ~(x = y) ==> (g(f x) = 0))
       ==> (sum {f x | x | x IN s /\ ~(f x = a)} g =
            sum s (g o f))``,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN ``FINITE {(f:'a->'b) x |x| x IN s /\ ~(f x = a)}``
  ASSUME_TAC THENL
   [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC ``IMAGE (f:'a->'b) s`` THEN
    ASM_SIMP_TAC std_ss [IMAGE_FINITE, SUBSET_DEF, IN_IMAGE, GSPECIFICATION] THEN MESON_TAC[],
    ASM_SIMP_TAC std_ss [sum_def] THEN MATCH_MP_TAC ITERATE_NONZERO_IMAGE_LEMMA THEN
    ASM_REWRITE_TAC[NEUTRAL_REAL_ADD, MONOIDAL_REAL_ADD]]);

Theorem INTERVAL_DOUBLESPLIT :
    !e a b c. interval[a,b] INTER {x:real | abs(x - c) <= e} =
              interval[(max (a) (c - e)), (min (b) (c + e))]
Proof
   REWRITE_TAC[REAL_ARITH ``abs(x - c) <= e <=> x >= c - e /\ x <= c + e:real``] THEN
   ONCE_REWRITE_TAC [METIS [] ``x >= c - e <=> (\x. x >= c - e:real) x``] THEN
   ONCE_REWRITE_TAC [METIS [] ``x <= c + e <=> (\x. x <= c + e:real) x``] THEN
   REWRITE_TAC[SET_RULE ``s INTER {x | P x /\ Q x} =
                         (s INTER {x | Q x}) INTER {x | P x}``] THEN
   SIMP_TAC std_ss [INTERVAL_SPLIT]
QED

val DIVISION_DOUBLESPLIT = store_thm ("DIVISION_DOUBLESPLIT",
 ``!p a b:real c e.
        p division_of interval[a,b]
        ==> {l INTER {x | abs(x - c) <= e} |l|
                l IN p /\ ~(l INTER {x | abs(x - c) <= e} = {})}
            division_of (interval[a,b] INTER {x | abs(x - c) <= e})``,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o SPEC ``c + e:real`` o MATCH_MP DIVISION_SPLIT) THEN
  DISCH_THEN(MP_TAC o CONJUNCT1) THEN
  ASM_SIMP_TAC std_ss [INTERVAL_SPLIT] THEN
  FIRST_ASSUM MP_TAC THEN REWRITE_TAC[AND_IMP_INTRO] THEN
  DISCH_THEN(MP_TAC o MATCH_MP (TAUT
   `(a) /\ d ==> d`)) THEN
  DISCH_THEN(MP_TAC o CONJUNCT2 o SPEC ``c - e:real`` o
    MATCH_MP DIVISION_SPLIT) THEN
  ASM_SIMP_TAC std_ss [INTERVAL_DOUBLESPLIT, INTERVAL_SPLIT] THEN
  MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN AP_TERM_TAC THEN
  REWRITE_TAC[REAL_ARITH ``abs(x - c) <= e <=> x >= c - e /\ x <= c + e:real``] THEN
  GEN_REWR_TAC I [EXTENSION] THEN SIMP_TAC std_ss [IN_INTER, GSPECIFICATION] THEN
  GEN_TAC THEN ONCE_REWRITE_TAC [CONJ_SYM] THEN SIMP_TAC std_ss [GSYM LEFT_EXISTS_AND_THM] THEN
  ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN
  ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> c /\ a /\ b /\ d`] THEN
  SIMP_TAC std_ss [UNWIND_THM2] THEN AP_TERM_TAC THEN ABS_TAC THEN SET_TAC[]);

Theorem CONTENT_DOUBLESPLIT :
    !a b:real c e.
        &0 < e ==> ?d. &0 < d /\
                content(interval[a,b] INTER {x | abs(x - c) <= d}) < e
Proof
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC ``content(interval[a:real,b]) = &0`` THENL
   [EXISTS_TAC ``&1:real`` THEN REWRITE_TAC[REAL_LT_01] THEN
    MATCH_MP_TAC REAL_LET_TRANS THEN
    EXISTS_TAC ``content(interval[a:real,b])`` THEN
    CONJ_TAC THENL [FIRST_X_ASSUM(K ALL_TAC o SYM), ASM_SIMP_TAC std_ss []] THEN
    ASM_SIMP_TAC std_ss [INTERVAL_DOUBLESPLIT] THEN MATCH_MP_TAC CONTENT_SUBSET THEN
    ASM_SIMP_TAC std_ss [GSYM INTERVAL_DOUBLESPLIT] THEN SET_TAC[], ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [CONTENT_EQ_0]) THEN
  REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN
  SUBGOAL_THEN ``&0 < (b:real) - (a:real)`` ASSUME_TAC THENL
   [ASM_REAL_ARITH_TAC, ALL_TAC] THEN
  ABBREV_TAC ``d = e / &3:real`` THEN
  EXISTS_TAC ``d:real`` THEN SUBGOAL_THEN ``&0 < d:real`` ASSUME_TAC THENL
   [EXPAND_TAC "d" THEN
    ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT],
    ALL_TAC] THEN
  ASM_SIMP_TAC std_ss [content, INTERVAL_DOUBLESPLIT] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(ASSUME_TAC o REWRITE_RULE [INTERVAL_NE_EMPTY]) THEN
  ASM_SIMP_TAC std_ss [INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND, REAL_LT_IMP_LE] THEN
  MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ``&2 * d:real`` THEN
  reverse CONJ_TAC
  >- (MATCH_MP_TAC(REAL_ARITH ``&0 < d /\ &3 * d <= x ==> &2 * d < x:real``) THEN
      ASM_REWRITE_TAC[] THEN
      FULL_SIMP_TAC std_ss [REAL_EQ_LDIV_EQ, REAL_ARITH ``0 < 3:real``] THEN
      REAL_ARITH_TAC) THEN
  fs [min_def, max_def] THEN
  Cases_on `a <= c - d` >> Cases_on `b <= c + d` >> fs [] THEN
  REAL_ASM_ARITH_TAC
QED

val NEGLIGIBLE_STANDARD_HYPERPLANE = store_thm ("NEGLIGIBLE_STANDARD_HYPERPLANE",
 ``!c. negligible {x:real | x = c}``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[negligible, has_integral] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
  MP_TAC(ISPECL [``a:real``, ``b:real``,  ``c:real``, ``e:real``]
        CONTENT_DOUBLESPLIT) THEN
  ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
  EXISTS_TAC ``\x:real. ball(x,d)`` THEN ASM_SIMP_TAC std_ss [GAUGE_BALL] THEN
  ABBREV_TAC ``i = indicator {x:real | x = c}`` THEN REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   ``sum p (\(x,l). content l * i x) =
     sum p (\(x,l). content(l INTER {x:real | abs(x - c) <= d}) *
                    (i:real->real) x)`` SUBST1_TAC THENL

   [MATCH_MP_TAC SUM_EQ THEN SIMP_TAC std_ss [FORALL_PROD] THEN
    MAP_EVERY X_GEN_TAC [``x:real``, ``l:real->bool``] THEN
    DISCH_TAC THEN EXPAND_TAC "i" THEN REWRITE_TAC[indicator] THEN
    SIMP_TAC std_ss [GSPECIFICATION] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN
    AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
    UNDISCH_TAC ``(\x. ball (x,d)) FINE p`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [FINE]) THEN
    DISCH_THEN(MP_TAC o SPECL [``x:real``, ``l:real->bool``]) THEN
    ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC(SET_RULE ``s SUBSET t ==> l SUBSET s ==> (l = l INTER t)``) THEN
    SIMP_TAC std_ss [SUBSET_DEF, IN_BALL, GSPECIFICATION, dist] THEN
    UNDISCH_THEN ``(x:real) = c`` (SUBST1_TAC o SYM) THEN
    GEN_REWR_TAC (QUANT_CONV o LAND_CONV o LAND_CONV) [ABS_SUB] THEN
    METIS_TAC[REAL_LE_TRANS, REAL_LT_IMP_LE], ALL_TAC] THEN
  MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC
   ``abs(sum p (\(x:real,l).
          content(l INTER {x:real | abs(x - c) <= d}) * 1:real))`` THEN
  CONJ_TAC THENL
   [UNDISCH_TAC ``p tagged_division_of interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
    MATCH_MP_TAC(REAL_ARITH ``&0:real <= x /\ x <= y ==> abs(x) <= abs(y)``) THEN
    CONJ_TAC THENL [MATCH_MP_TAC SUM_POS_LE, MATCH_MP_TAC SUM_LE] THEN
    ASM_SIMP_TAC std_ss [FORALL_PROD] THEN
    MAP_EVERY X_GEN_TAC [``x:real``, ``l:real->bool``] THEN STRIP_TAC THENL
     [MATCH_MP_TAC REAL_LE_MUL, MATCH_MP_TAC REAL_LE_LMUL1] THEN
    EXPAND_TAC "i" THEN
    SIMP_TAC std_ss [DROP_INDICATOR_POS_LE, DROP_INDICATOR_LE_1] THEN
    UNDISCH_TAC ``p tagged_division_of interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [TAGGED_DIVISION_OF]) THEN
    ASM_REWRITE_TAC [] THEN
    DISCH_THEN(MP_TAC o SPECL [``x:real``, ``l:real->bool``] o
        el 1 o CONJUNCTS) THEN
    ASM_REWRITE_TAC[] THEN
    STRIP_TAC THEN ASM_SIMP_TAC std_ss [INTERVAL_DOUBLESPLIT, CONTENT_POS_LE],
    ALL_TAC] THEN
  MP_TAC(ISPECL [``(\l. content (l INTER {x | abs (x - c) <= d}) * 1):
                  (real->bool)->real``,
                 ``p:real#(real->bool)->bool``,
                 ``interval[a:real,b]``]
        SUM_OVER_TAGGED_DIVISION_LEMMA) THEN
  ASM_REWRITE_TAC[] THEN KNOW_TAC ``(!u v.
        interval [(u,v)] <> {} /\ (content (interval [(u,v)]) = 0) ==>
        ((\l. content (l INTER {x | abs (x - c) <= d}) * 1)
           (interval [(u,v)]) = 0))`` THENL
   [MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN STRIP_TAC THEN
    SIMP_TAC std_ss [REAL_ENTIRE] THEN DISJ1_TAC THEN
    MATCH_MP_TAC(REAL_ARITH ``!x. (x = &0) /\ &0 <= y /\ y <= x ==> (y = &0:real)``) THEN
    EXISTS_TAC ``content(interval[u:real,v])`` THEN
    CONJ_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[] THEN
    DISCH_THEN(K ALL_TAC) THEN
    ASM_SIMP_TAC std_ss [CONTENT_POS_LE, INTERVAL_DOUBLESPLIT] THEN
    MATCH_MP_TAC CONTENT_SUBSET THEN
    ASM_SIMP_TAC std_ss [GSYM INTERVAL_DOUBLESPLIT] THEN SET_TAC[],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  SIMP_TAC std_ss [] THEN DISCH_THEN SUBST1_TAC THEN
  MP_TAC(ISPECL
     [``IMAGE SND (p:real#(real->bool)->bool)``,
      ``\l. l INTER {x:real | abs (x - c) <= d}``,
      ``\l:real->bool. content l * 1 :real``,
      ``{}:real->bool``] SUM_NONZERO_IMAGE_LEMMA) THEN
    SIMP_TAC std_ss [o_DEF] THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_TAGGED_DIVISION) THEN
  KNOW_TAC ``FINITE
       (IMAGE (SND :real # (real -> bool) -> real -> bool)
          (p :real # (real -> bool) -> bool)) /\
     (content ({} :real -> bool) * (1 :real) = (0 :real)) /\
     (!(x :real -> bool) (y :real -> bool).
        x IN IMAGE (SND :real # (real -> bool) -> real -> bool) p /\
        y IN IMAGE (SND :real # (real -> bool) -> real -> bool) p /\
        (x INTER {x | abs (x - (c :real)) <= (d :real)} =
         y INTER {x | abs (x - c) <= d}) /\ x <> y ==>
        (content (y INTER {x | abs (x - c) <= d}) * (1 :real) =
         (0 : real)))`` THENL
   [CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_FINITE], ALL_TAC] THEN
    REWRITE_TAC[CONTENT_EMPTY, REAL_MUL_LZERO] THEN
    ONCE_REWRITE_TAC[IMP_CONJ] THEN
    SIMP_TAC std_ss [RIGHT_FORALL_IMP_THM] THEN
    FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
    MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN DISCH_TAC THEN
    X_GEN_TAC ``m:real->bool`` THEN STRIP_TAC THEN
    REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN
    POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
    GEN_REWR_TAC LAND_CONV [EQ_SYM_EQ] THEN DISCH_TAC THEN DISCH_TAC THEN
    ASM_REWRITE_TAC [] THEN
    SIMP_TAC std_ss [INTERVAL_DOUBLESPLIT] THEN
    SIMP_TAC std_ss [CONTENT_EQ_0_INTERIOR] THEN
    ASM_SIMP_TAC std_ss [GSYM INTERVAL_DOUBLESPLIT] THEN
    UNDISCH_TAC `` IMAGE (SND :real # (real -> bool) -> real -> bool)
            (p :real # (real -> bool) -> bool) division_of
          interval [((a :real),(b :real))]`` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
    DISCH_THEN (MP_TAC o SPECL [``interval[u:real,v]``, ``m:real->bool``]) THEN
    ASM_REWRITE_TAC[] THEN
    UNDISCH_TAC `` (m :real -> bool) INTER {x | abs (x - (c :real)) <= (d :real)} =
          interval [((u :real),(v :real))] INTER {x | abs (x - c) <= d}`` THEN
    GEN_REWR_TAC LAND_CONV [EQ_SYM_EQ] THEN DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
    MATCH_MP_TAC(SET_RULE
      ``u SUBSET s /\ u SUBSET t ==> (s INTER t = {}) ==> (u = {})``) THEN
    CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN ASM_SET_TAC[],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  SIMP_TAC std_ss [o_DEF] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
  MATCH_MP_TAC REAL_LET_TRANS THEN
  EXISTS_TAC
   ``&1 * content(interval[a,b] INTER {x:real | abs (x - c) <= d})`` THEN
  CONJ_TAC THENL [ALL_TAC, ASM_REWRITE_TAC[REAL_MUL_LID]] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ]
    DIVISION_DOUBLESPLIT)) THEN
  DISCH_THEN(MP_TAC o SPECL [``c:real``, ``d:real``]) THEN
  ASM_SIMP_TAC std_ss [INTERVAL_DOUBLESPLIT] THEN DISCH_TAC THEN
  MATCH_MP_TAC DSUM_BOUND THEN
  ASM_SIMP_TAC std_ss [LESS_EQ_REFL] THEN
  REAL_ARITH_TAC);

(* ------------------------------------------------------------------------- *)
(* A technical lemma about "refinement" of division.                         *)
(* ------------------------------------------------------------------------- *)

val lemma1 = prove (
  ``{k | ?x. (x,k) IN p} = IMAGE SND p``,
  SIMP_TAC std_ss [EXTENSION, EXISTS_PROD, IN_IMAGE, GSPECIFICATION] THEN
    METIS_TAC[]);

val TAGGED_DIVISION_FINER = store_thm ("TAGGED_DIVISION_FINER",
 ``!p a b:real d. p tagged_division_of interval[a,b] /\ gauge d
             ==> ?q. q tagged_division_of interval[a,b] /\ d FINE q /\
                     !x k. (x,k) IN p /\ k SUBSET d(x) ==> (x,k) IN q``,
  SUBGOAL_THEN
   ``!a b:real d p.
       FINITE p
       ==> p tagged_partial_division_of interval[a,b] /\ gauge d
           ==> ?q. q tagged_division_of (BIGUNION {k | ?x. (x,k) IN p}) /\
                   d FINE q /\
                   !x k. (x,k) IN p /\ k SUBSET d(x) ==> (x,k) IN q``
  ASSUME_TAC THENL
   [ALL_TAC,
    REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
    GEN_REWR_TAC LAND_CONV [tagged_division_of] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN
    FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE [AND_IMP_INTRO]) THEN
    ASM_MESON_TAC[tagged_partial_division_of]] THEN
  GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN
  ONCE_REWRITE_TAC [ METIS []
          ``!p. (p tagged_partial_division_of interval [(a,b)] /\ gauge d ==>
      ?q. q tagged_division_of BIGUNION {k | ?x. (x,k) IN p} /\ d FINE q /\
        !x k. (x,k) IN p /\ k SUBSET d x ==> (x,k) IN q) =
           (\p. ( p tagged_partial_division_of interval [(a,b)] /\ gauge d ==>
      ?q. q tagged_division_of BIGUNION {k | ?x. (x,k) IN p} /\ d FINE q /\
        !x k. (x,k) IN p /\ k SUBSET d x ==> (x,k) IN q)) p ``] THEN
  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN CONJ_TAC THENL
   [DISCH_THEN(K ALL_TAC) THEN
    REWRITE_TAC[SET_RULE ``BIGUNION {k | ?x. (x,k) IN {}} = {}``] THEN
    EXISTS_TAC ``{}:real#(real->bool)->bool`` THEN
    REWRITE_TAC[FINE, NOT_IN_EMPTY, TAGGED_DIVISION_OF_EMPTY],
    ALL_TAC] THEN
  SIMP_TAC std_ss [RIGHT_IMP_FORALL_THM] THEN
  SIMP_TAC std_ss [FORALL_PROD] THEN MAP_EVERY X_GEN_TAC
   [``p:real#(real->bool)->bool``, ``x:real``, ``k:real->bool``] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN
  DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN
  KNOW_TAC ``p tagged_partial_division_of interval [(a,b)] /\ gauge d`` THENL
   [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TAGGED_PARTIAL_DIVISION_SUBSET THEN
    EXISTS_TAC ``(x:real,k:real->bool) INSERT p`` THEN ASM_SET_TAC[],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN ``q1:real#(real->bool)->bool``
    STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   ``BIGUNION {l:real->bool | ?y:real. (y,l) IN (x,k) INSERT p} =
    k UNION BIGUNION {l | ?y. (y,l) IN p}``
  SUBST1_TAC THENL
   [GEN_REWR_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNION, IN_BIGUNION] THEN
    SIMP_TAC std_ss [GSPECIFICATION, IN_INSERT, PAIR_EQ] THEN MESON_TAC[],
    ALL_TAC] THEN
  SUBGOAL_THEN ``?u v:real. k = interval[u,v]`` MP_TAC THENL
   [ASM_MESON_TAC[IN_INSERT, tagged_partial_division_of], ALL_TAC] THEN
  DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THEN
  ASM_CASES_TAC ``interval[u,v] SUBSET ((d:real->real->bool) x)`` THENL
   [EXISTS_TAC ``{(x:real,interval[u:real,v])} UNION q1`` THEN CONJ_TAC THENL
     [MATCH_MP_TAC TAGGED_DIVISION_UNION THEN ASM_SIMP_TAC std_ss [] THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC TAGGED_DIVISION_OF_SELF THEN
        UNDISCH_TAC `` (x,interval [(u,v)]) INSERT p tagged_partial_division_of
          interval [(a,b)]`` THEN DISCH_TAC THEN
        FIRST_X_ASSUM(MP_TAC o REWRITE_RULE
         [tagged_partial_division_of]) THEN
        SIMP_TAC std_ss [IN_INSERT, PAIR_EQ] THEN METIS_TAC[],
        ALL_TAC],
      CONJ_TAC THENL
       [MATCH_MP_TAC FINE_UNION THEN ASM_REWRITE_TAC[] THEN
        SIMP_TAC std_ss [FINE, IN_SING, PAIR_EQ] THEN METIS_TAC[],
        ALL_TAC] THEN
      ASM_SIMP_TAC std_ss [IN_INSERT, PAIR_EQ, IN_UNION, IN_SING] THEN
      METIS_TAC[]],
    FIRST_ASSUM(MP_TAC o SPECL [``u:real``, ``v:real``] o MATCH_MP
      FINE_DIVISION_EXISTS) THEN
    DISCH_THEN(X_CHOOSE_THEN ``q2:real#(real->bool)->bool``
      STRIP_ASSUME_TAC) THEN
    EXISTS_TAC ``q2 UNION q1:real#(real->bool)->bool`` THEN CONJ_TAC THENL
     [MATCH_MP_TAC TAGGED_DIVISION_UNION THEN ASM_REWRITE_TAC[],
      ASM_SIMP_TAC std_ss [FINE_UNION] THEN
      ASM_SIMP_TAC std_ss [IN_INSERT, PAIR_EQ, IN_UNION, IN_SING] THEN
      METIS_TAC[]]] THEN
  (MATCH_MP_TAC INTER_INTERIOR_BIGUNION_INTERVALS THEN
   SIMP_TAC std_ss [lemma1, GSPECIFICATION, LEFT_IMP_EXISTS_THM] THEN
   UNDISCH_TAC ``(x,interval [(u,v)]) INSERT p tagged_partial_division_of
          interval [(a,b)]`` THEN DISCH_TAC THEN
   FIRST_X_ASSUM(MP_TAC o REWRITE_RULE
      [tagged_partial_division_of]) THEN
   SIMP_TAC std_ss [IN_INSERT, FINITE_INSERT, PAIR_EQ] THEN
   STRIP_TAC THEN ASM_SIMP_TAC std_ss [IMAGE_FINITE] THEN CONJ_TAC THENL
    [SIMP_TAC std_ss [INTERIOR_CLOSED_INTERVAL, OPEN_INTERVAL], ALL_TAC] THEN
   CONJ_TAC THENL [ASM_MESON_TAC[], ALL_TAC] THEN
   REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
   ASM_MESON_TAC[]));

(* ------------------------------------------------------------------------- *)
(* Hence the main theorem about negligible sets.                             *)
(* ------------------------------------------------------------------------- *)

val lemma = prove (
   ``!f:'b->real g:'a#'b->real s t.
          FINITE s /\ FINITE t /\
          (!x y. (x,y) IN t ==> &0 <= g(x,y)) /\
          (!y. y IN s ==> ?x. (x,y) IN t /\ f(y) <= g(x,y))
          ==> sum s f <= sum t g``,
    REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_LE_INCLUDED THEN
    EXISTS_TAC ``SND:'a#'b->'b`` THEN
    SIMP_TAC std_ss [EXISTS_PROD, FORALL_PROD] THEN
    ASM_MESON_TAC[]);

val REAL_MUL_POS_LT = store_thm ("REAL_MUL_POS_LT",
 ``!x y:real. &0 < x * y <=> &0 < x /\ &0 < y \/ x < &0 /\ y < &0``,
  REPEAT STRIP_TAC THEN
  STRIP_ASSUME_TAC(SPEC ``x:real`` REAL_LT_NEGTOTAL) THEN
  STRIP_ASSUME_TAC(SPEC ``y:real`` REAL_LT_NEGTOTAL) THEN
  ASM_REWRITE_TAC[REAL_MUL_LZERO, REAL_MUL_RZERO, REAL_LT_REFL] THEN
  ASSUM_LIST(MP_TAC o MATCH_MP REAL_LT_MUL o end_itlist CONJ) THEN
  REPEAT(POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC);

val SUP_FINITE_LEMMA = store_thm ("SUP_FINITE_LEMMA",
 ``!s. FINITE s /\ ~(s = {}) ==> ?b:real. b IN s /\ !x. x IN s ==> x <= b``,
  REWRITE_TAC[IMP_CONJ] THEN
  ONCE_REWRITE_TAC [METIS [] ``!s. (s <> {} ==> ?b:real. b IN s /\ !x. x IN s ==> x <= b) =
                        (\s. s <> {} ==> ?b. b IN s /\ !x. x IN s ==> x <= b) s``] THEN
  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
  REWRITE_TAC[NOT_INSERT_EMPTY, IN_INSERT] THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
  MESON_TAC[REAL_LE_TOTAL, REAL_LE_TRANS]);

val SUP_FINITE = store_thm ("SUP_FINITE",
 ``!s:real->bool. FINITE s /\ ~(s = {}) ==> (sup s) IN s /\ !x. x IN s ==> x <= sup s``,
  GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP SUP_FINITE_LEMMA) THEN
  METIS_TAC[REAL_LE_ANTISYM, REAL_LE_TOTAL, SUP, SUP_FINITE_LEMMA]);

val REAL_SUP_LE_FINITE = store_thm ("REAL_SUP_LE_FINITE",
 ``!s a:real. FINITE s /\ ~(s = {}) ==> (sup s <= a <=> !x. x IN s ==> x <= a)``,
  METIS_TAC[SUP_FINITE, REAL_LE_TRANS]);

val HAS_INTEGRAL_NEGLIGIBLE = store_thm ("HAS_INTEGRAL_NEGLIGIBLE",
 ``!f:real->real s t.
        negligible s /\ (!x. x IN (t DIFF s) ==> (f x = 0))
        ==> (f has_integral (0)) t``,
  SUBGOAL_THEN
   ``!f:real->real s a b.
        negligible s /\ (!x. ~(x IN s) ==> (f x = 0))
        ==> (f has_integral (0)) (interval[a,b])``
  ASSUME_TAC THENL
   [ALL_TAC,
    REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN
    ONCE_REWRITE_TAC[has_integral_alt] THEN COND_CASES_TAC THENL
     [MATCH_MP_TAC HAS_INTEGRAL_EQ THEN
      EXISTS_TAC ``\x. if x IN t then (f:real->real) x else 0`` THEN
      SIMP_TAC std_ss [] THEN
      FIRST_X_ASSUM(CHOOSE_THEN(CHOOSE_THEN SUBST_ALL_TAC)) THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN METIS_TAC[],
      ALL_TAC] THEN
    GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC ``&1:real`` THEN
    REWRITE_TAC[REAL_LT_01] THEN
    REPEAT STRIP_TAC THEN EXISTS_TAC ``0:real`` THEN
    ASM_REWRITE_TAC[ABS_0, REAL_SUB_REFL] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    EXISTS_TAC ``s:real->bool`` THEN METIS_TAC[]] THEN
  SIMP_TAC std_ss [negligible, has_integral, RIGHT_FORALL_IMP_THM] THEN
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN
  POP_ASSUM (MP_TAC o Q.SPECL [`a:real`,`b:real`]) THEN
  REWRITE_TAC[REAL_SUB_RZERO] THEN DISCH_TAC THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN ``n:num`` o
      SPEC ``e / &2 / ((&n + &1:real) * &2 pow n)``) THEN
  REWRITE_TAC[real_div, REAL_MUL_POS_LT] THEN REWRITE_TAC[GSYM real_div] THEN
  ASM_SIMP_TAC arith_ss [REAL_LT_INV_EQ, REAL_LT_MUL, REAL_POW_LT, REAL_LT,
           FORALL_AND_THM, METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0]
                            ``&0 < &n + &1:real``, SKOLEM_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN ``d:num->real->real->bool`` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC ``\x. (d:num->real->real->bool) (flr(abs(f x:real))) x`` THEN
  CONJ_TAC THENL [REWRITE_TAC[gauge_def] THEN METIS_TAC[gauge_def], ALL_TAC] THEN
  X_GEN_TAC ``p:real#(real->bool)->bool`` THEN STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
  ASM_CASES_TAC ``p:real#(real->bool)->bool = {}`` THEN
  ASM_REWRITE_TAC[SUM_CLAUSES, ABS_0] THEN
  MP_TAC(SPEC ``sup(IMAGE (\(x,k:real->bool). abs((f:real->real) x)) p)``
    SIMP_REAL_ARCH) THEN
  ASM_SIMP_TAC std_ss [REAL_SUP_LE_FINITE, IMAGE_FINITE, IMAGE_EQ_EMPTY] THEN
  SIMP_TAC std_ss [FORALL_IN_IMAGE, FORALL_PROD] THEN
  DISCH_THEN(X_CHOOSE_TAC ``N:num``) THEN
  MP_TAC(GEN ``i:num``
   (ISPECL [``p:real#(real->bool)->bool``, ``a:real``, ``b:real``,
                ``(d:num->real->real->bool) i``] TAGGED_DIVISION_FINER)) THEN
  ASM_SIMP_TAC std_ss [SKOLEM_THM, RIGHT_IMP_EXISTS_THM, FORALL_AND_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN ``q:num->real#(real->bool)->bool``
        STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC
   ``sum((0:num)..N+1:num) (\i. (&i + &1) *
                     abs(sum (q i) (\(x:real,k:real->bool).
                                            content k * indicator s x)))`` THEN
  CONJ_TAC THENL
   [ALL_TAC,
    MATCH_MP_TAC REAL_LET_TRANS THEN
    EXISTS_TAC ``sum ((0:num)..N+1:num) (\i. e / &2 / (&2:real) pow i)`` THEN CONJ_TAC THENL
     [ALL_TAC,
      SIMP_TAC std_ss [real_div, SUM_LMUL, GSYM REAL_POW_INV] THEN
      SIMP_TAC std_ss [SUM_GP, LT] THEN
      SIMP_TAC std_ss [METIS [REAL_ARITH ``1 <> 2:real``, REAL_INV_1OVER, REAL_EQ_LDIV_EQ,
                               REAL_ARITH ``0 < 2:real``, REAL_MUL_LID] ``inv 2 <> 1:real``,
                        pow, REAL_INV_1OVER] THEN
      SIMP_TAC std_ss [METIS [REAL_HALF_DOUBLE, REAL_EQ_SUB_RADD] ``1 - 1 / 2 = 1 / 2:real``] THEN
      REWRITE_TAC [METIS [GSYM pow] ``(1 / 2) * (1 / 2:real) pow (N + 1:num) =
                                      (1 / 2) pow SUC (N + 1)``] THEN
      KNOW_TAC ``!e x. e * (&1 / &2) * ((&1 - x) / (&1 / &2)) < e <=>
                                &0 < e * x:real`` THENL
      [GEN_TAC THEN GEN_TAC THEN REWRITE_TAC [real_div, REAL_MUL_LID, REAL_INV_INV] THEN
       ONCE_REWRITE_TAC [REAL_ARITH ``a * b * (c * d) = (a * (b * d)) * c:real``] THEN
       SIMP_TAC std_ss [REAL_MUL_LID, REAL_ARITH ``2 <> 0:real``,
        REAL_MUL_LINV, REAL_MUL_RID] THEN REAL_ARITH_TAC, ALL_TAC] THEN
      DISCH_TAC THEN ASM_SIMP_TAC std_ss [REAL_MUL_LID, REAL_INV_INV] THEN
      KNOW_TAC ``&0 < &1 / &2:real`` THENL
       [SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
        REAL_ARITH_TAC, DISCH_TAC] THEN
      ASM_SIMP_TAC std_ss [REAL_LT_MUL, REAL_POW_LT, REAL_INV_1OVER]] THEN
    MATCH_MP_TAC SUM_LE_NUMSEG THEN REPEAT STRIP_TAC THEN
    SIMP_TAC std_ss [] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
    ASM_SIMP_TAC std_ss [GSYM REAL_LE_RDIV_EQ, METIS
     [ADD1, LESS_0, REAL_OF_NUM_ADD, REAL_LT] ``&0 < &n + &1:real``] THEN
    REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
    KNOW_TAC ``(2 pow i) <> 0:real /\ (&i + 1) <> 0:real`` THENL
    [CONJ_TAC THENL [MATCH_MP_TAC POW_NZ THEN REAL_ARITH_TAC, ALL_TAC] THEN
     REWRITE_TAC [REAL_OF_NUM_ADD, GSYM ADD1] THEN
     REWRITE_TAC [REAL_LT_NZ, REAL_LT, LESS_0], STRIP_TAC] THEN
    ASM_SIMP_TAC std_ss [GSYM REAL_INV_MUL] THEN REWRITE_TAC[GSYM real_div] THEN
    GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN
    MATCH_MP_TAC REAL_LT_IMP_LE THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]] THEN
  FIRST_ASSUM(ASSUME_TAC o GEN ``i:num`` o
    MATCH_MP TAGGED_DIVISION_OF_FINITE o SPEC ``i:num``) THEN
  GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV) [abs] THEN
  SUBGOAL_THEN
   ``!i:num. &0 <= sum (q i) (\(x:real,y:real->bool).
              content y * (indicator s x))``
  ASSUME_TAC THENL
   [REPEAT GEN_TAC THEN MATCH_MP_TAC SUM_POS_LE THEN
    ASM_SIMP_TAC std_ss [FORALL_PROD] THEN
    REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN
    REWRITE_TAC[DROP_INDICATOR_POS_LE] THEN
    ASM_MESON_TAC[TAGGED_DIVISION_OF, CONTENT_POS_LE],
    ALL_TAC] THEN
  ASM_REWRITE_TAC[GSYM SUM_LMUL] THEN
  SIMP_TAC std_ss [LAMBDA_PROD] THEN
  W(MP_TAC o PART_MATCH (lhand o rand) SUM_ABS o lhand o snd) THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC(REAL_ARITH ``x <= y ==> n <= x ==> n <= y:real``) THEN
  ASM_SIMP_TAC std_ss [SUM_SUM_PRODUCT, FINITE_NUMSEG] THEN
  MATCH_MP_TAC lemma THEN
  ASM_SIMP_TAC std_ss [FINITE_PRODUCT_DEPENDENT, FORALL_PROD, FINITE_NUMSEG] THEN
  SIMP_TAC std_ss [IN_ELIM_PAIR_THM] THEN CONJ_TAC THENL
   [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN
    CONJ_TAC THENL [METIS_TAC [ADD1, LESS_0, REAL_OF_NUM_ADD, REAL_LT, REAL_LE_LT],
                    MATCH_MP_TAC REAL_LE_MUL] THEN
    REWRITE_TAC[DROP_INDICATOR_POS_LE] THEN
    ASM_MESON_TAC[TAGGED_DIVISION_OF, CONTENT_POS_LE],
    ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN DISCH_TAC THEN
  UNDISCH_TAC ``(\(x :real).
             (d :num -> real -> real -> bool)
               (flr (abs ((f :real -> real) x))) x) FINE
          (p :real # (real -> bool) -> bool)`` THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o REWRITE_RULE [FINE]) THEN
  DISCH_THEN(MP_TAC o SPECL [``x:real``, ``k:real->bool``]) THEN
  ASM_SIMP_TAC std_ss [] THEN ABBREV_TAC
   ``n = (flr(abs((f:real->real) x)))`` THEN
  SUBGOAL_THEN ``&n <= abs((f:real->real) x) /\
                abs(f x) < &n + &1``
  STRIP_ASSUME_TAC THENL
   [EXPAND_TAC "n" THEN
    SIMP_TAC std_ss [NUM_FLOOR_LE, ABS_POS] THEN
    REWRITE_TAC [REAL_OF_NUM_ADD] THEN
    REWRITE_TAC [METIS [REAL_OVER1, REAL_MUL_RID]
                 ``&(flr (abs ((f :real -> real) x)) + 1):real =
                   &(flr ((abs (f x)) / 1) + 1) * 1``] THEN
    MATCH_MP_TAC NUM_FLOOR_DIV_LOWERBOUND THEN REAL_ARITH_TAC, ALL_TAC] THEN
  DISCH_TAC THEN EXISTS_TAC ``n:num`` THEN ASM_SIMP_TAC std_ss [] THEN CONJ_TAC THENL
   [ASM_SIMP_TAC std_ss [IN_NUMSEG, LE_0] THEN
    REWRITE_TAC[GSYM REAL_OF_NUM_LE, GSYM REAL_OF_NUM_ADD] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC ``abs((f:real->real) x)`` THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC(REAL_ARITH ``x <= n ==> x <= n + &1:real``) THEN
    ASM_MESON_TAC[], ALL_TAC] THEN
  ASM_CASES_TAC ``(x:real) IN s`` THEN ASM_SIMP_TAC std_ss [indicator] THEN
  SIMP_TAC std_ss [REAL_MUL_RZERO, ABS_0,
              REAL_MUL_RZERO, REAL_LE_REFL] THEN
  ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
  REWRITE_TAC[REAL_MUL_RID, ABS_MUL] THEN
  SUBGOAL_THEN ``&0 <= content(k:real->bool)`` ASSUME_TAC THENL
   [ASM_MESON_TAC[TAGGED_DIVISION_OF, CONTENT_POS_LE], ALL_TAC] THEN
  ASM_REWRITE_TAC[abs] THEN GEN_REWR_TAC LAND_CONV [REAL_MUL_SYM] THEN
  POP_ASSUM MP_TAC THEN GEN_REWR_TAC LAND_CONV [REAL_LE_LT] THEN
  STRIP_TAC THENL [ASM_SIMP_TAC std_ss [REAL_LE_LMUL] THEN
   REWRITE_TAC [GSYM abs] THEN ASM_REWRITE_TAC [REAL_LE_LT],
   POP_ASSUM (MP_TAC o ONCE_REWRITE_RULE [EQ_SYM_EQ]) THEN DISCH_TAC THEN
   ASM_REWRITE_TAC []] THEN REAL_ARITH_TAC);

val HAS_INTEGRAL_SPIKE = store_thm ("HAS_INTEGRAL_SPIKE",
 ``!f:real->real g s t y.
        negligible s /\ (!x. x IN (t DIFF s) ==> (g x = f x)) /\
        (f has_integral y) t ==> (g has_integral y) t``,
  SUBGOAL_THEN
   ``!f:real->real g s a b y.
        negligible s /\ (!x. x IN (interval[a,b] DIFF s) ==> (g x = f x))
        ==> (f has_integral y) (interval[a,b])
            ==> (g has_integral y) (interval[a,b])``
  ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN
    SUBGOAL_THEN
     ``((\x. (f:real->real)(x) + (g(x) - f(x))) has_integral (y + 0))
      (interval[a,b])``
    MP_TAC THENL
     [ALL_TAC,
      SIMP_TAC std_ss [REAL_ARITH ``((f:real->real) x + (g x - f x) = g x) /\
                                     (f x + 0 = f x)``, ETA_AX, REAL_ADD_RID]] THEN
    ONCE_REWRITE_TAC [METIS [] ``(g x - (f:real->real) x) = (\x. g x - f x) x``] THEN
    MATCH_MP_TAC HAS_INTEGRAL_ADD THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC HAS_INTEGRAL_NEGLIGIBLE THEN
    EXISTS_TAC ``s:real->bool`` THEN ASM_SIMP_TAC std_ss [REAL_SUB_0],
    ALL_TAC] THEN
  REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  ONCE_REWRITE_TAC[has_integral_alt] THEN COND_CASES_TAC THEN
  ASM_REWRITE_TAC[] THENL
   [FIRST_X_ASSUM(CHOOSE_THEN(CHOOSE_THEN SUBST_ALL_TAC)) THEN ASM_MESON_TAC[],
    ALL_TAC] THEN
  DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `e:real`) THEN
  MATCH_MP_TAC MONO_IMP THEN
  REWRITE_TAC[] THEN DISCH_THEN (X_CHOOSE_TAC ``B:real``) THEN
  EXISTS_TAC ``B:real`` THEN POP_ASSUM MP_TAC THEN
  MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
  DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN
  POP_ASSUM (MP_TAC o Q.SPECL [`a:real`,`b:real`]) THEN
  MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
  DISCH_THEN (X_CHOOSE_TAC ``z:real``) THEN EXISTS_TAC ``z:real`` THEN
  POP_ASSUM MP_TAC THEN
  MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC ``s:real->bool`` THEN
  ASM_REWRITE_TAC[] THEN ASM_SET_TAC[]);

val HAS_INTEGRAL_SPIKE_EQ = store_thm ("HAS_INTEGRAL_SPIKE_EQ",
 ``!f:real->real g s t y.
        negligible s /\ (!x. x IN (t DIFF s) ==> (g x = f x))
        ==> ((f has_integral y) t <=> (g has_integral y) t)``,
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
  MATCH_MP_TAC HAS_INTEGRAL_SPIKE THENL
   [EXISTS_TAC ``f:real->real``, EXISTS_TAC ``g:real->real``] THEN
  EXISTS_TAC ``s:real->bool`` THEN ASM_SIMP_TAC std_ss [] THEN
  ASM_MESON_TAC[ABS_SUB]);

val INTEGRABLE_SPIKE = store_thm ("INTEGRABLE_SPIKE",
 ``!f:real->real g s t.
        negligible s /\ (!x. x IN (t DIFF s) ==> (g x = f x))
        ==> f integrable_on t ==> g integrable_on  t``,
  REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[integrable_on] THEN
  STRIP_TAC THEN EXISTS_TAC ``y:real`` THEN POP_ASSUM (MP_TAC) THEN
  MP_TAC(SPEC_ALL HAS_INTEGRAL_SPIKE) THEN ASM_REWRITE_TAC[]);

val INTEGRABLE_SPIKE_EQ = store_thm ("INTEGRABLE_SPIKE_EQ",
 ``!f:real->real g s t.
        negligible s /\ (!x. x IN t DIFF s ==> (g x = f x))
        ==> (f integrable_on t <=> g integrable_on t)``,
  MESON_TAC[INTEGRABLE_SPIKE]);

val INTEGRAL_SPIKE = store_thm ("INTEGRAL_SPIKE",
 ``!f:real->real g s t y.
        negligible s /\ (!x. x IN (t DIFF s) ==> (g x = f x))
        ==> (integral t f = integral t g)``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[integral] THEN
  AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ THEN
  ASM_MESON_TAC[]);

(* ------------------------------------------------------------------------- *)
(* Some other trivialities about negligible sets.                            *)
(* ------------------------------------------------------------------------- *)

val NEGLIGIBLE_SUBSET = store_thm ("NEGLIGIBLE_SUBSET",
 ``!s:real->bool t:real->bool.
        negligible s /\ t SUBSET s ==> negligible t``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[negligible] THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN
  MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN
  MAP_EVERY EXISTS_TAC [``(\x. 0):real->real``, ``s:real->bool``] THEN
  ASM_REWRITE_TAC[HAS_INTEGRAL_0] THEN
  REWRITE_TAC[indicator] THEN ASM_SET_TAC[]);

val NEGLIGIBLE_DIFF = store_thm ("NEGLIGIBLE_DIFF",
 ``!s t:real->bool. negligible s ==> negligible(s DIFF t)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
  EXISTS_TAC ``s:real->bool`` THEN ASM_SIMP_TAC std_ss [DIFF_SUBSET]);

val NEGLIGIBLE_INTER = store_thm ("NEGLIGIBLE_INTER",
 ``!s t. negligible s \/ negligible t ==> negligible(s INTER t)``,
  METIS_TAC [NEGLIGIBLE_SUBSET, INTER_SUBSET]);

val NEGLIGIBLE_UNION = store_thm ("NEGLIGIBLE_UNION",
 ``!s t:real->bool.
        negligible s /\ negligible t ==> negligible (s UNION t)``,
  REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MP_TAC THEN
  SIMP_TAC std_ss [negligible, GSYM FORALL_AND_THM] THEN
  DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN
  POP_ASSUM (MP_TAC o Q.SPECL [`a:real`,`b:real`]) THEN
  DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_ADD) THEN
  REWRITE_TAC[REAL_ADD_LID] THEN MATCH_MP_TAC EQ_IMPLIES THEN
  MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ THEN
  EXISTS_TAC ``s:real->bool`` THEN ASM_SIMP_TAC std_ss [] THEN
  SIMP_TAC std_ss [indicator, IN_UNION, IN_DIFF, REAL_ADD_LID]);

val NEGLIGIBLE_UNION_EQ = store_thm ("NEGLIGIBLE_UNION_EQ",
 ``!s t:real->bool.
        negligible (s UNION t) <=> negligible s /\ negligible t``,
  METIS_TAC[NEGLIGIBLE_UNION, SUBSET_UNION, NEGLIGIBLE_SUBSET]);

val NEGLIGIBLE_SING = store_thm ("NEGLIGIBLE_SING",
 ``!a:real. negligible {a}``,
  GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
  EXISTS_TAC ``{x | (x:real) = (a:real)}`` THEN
  SIMP_TAC std_ss [NEGLIGIBLE_STANDARD_HYPERPLANE, LESS_EQ_REFL] THEN
  SET_TAC[]);

val NEGLIGIBLE_INSERT = store_thm ("NEGLIGIBLE_INSERT",
 ``!a:real s. negligible(a INSERT s) <=> negligible s``,
  ONCE_REWRITE_TAC[SET_RULE ``a INSERT s = {a} UNION s``] THEN
  REWRITE_TAC[NEGLIGIBLE_UNION_EQ, NEGLIGIBLE_SING]);

val NEGLIGIBLE_EMPTY = store_thm ("NEGLIGIBLE_EMPTY",
 ``negligible {}``,
  METIS_TAC [EMPTY_SUBSET, NEGLIGIBLE_SUBSET, NEGLIGIBLE_SING]);

val NEGLIGIBLE_FINITE = store_thm ("NEGLIGIBLE_FINITE",
 ``!s. FINITE s ==> negligible s``,
  ONCE_REWRITE_TAC [METIS [] ``!s. (negligible s) = (\s. negligible s) s``] THEN
  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
  SIMP_TAC std_ss [NEGLIGIBLE_EMPTY, NEGLIGIBLE_INSERT]);

val NEGLIGIBLE_BIGUNION = store_thm ("NEGLIGIBLE_BIGUNION",
 ``!s. FINITE s /\ (!t. t IN s ==> negligible t)
       ==> negligible(BIGUNION s)``,
  REWRITE_TAC[IMP_CONJ] THEN
  ONCE_REWRITE_TAC [METIS []
  ``!s. ((!t. t IN s ==> negligible t) ==> negligible(BIGUNION s)) =
    (\s. (!t. t IN s ==> negligible t) ==> negligible(BIGUNION s)) s``] THEN
  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
  SIMP_TAC std_ss [BIGUNION_EMPTY, BIGUNION_INSERT, NEGLIGIBLE_EMPTY, IN_INSERT] THEN
  SIMP_TAC std_ss [NEGLIGIBLE_UNION]);

val NEGLIGIBLE = store_thm ("NEGLIGIBLE",
 ``!s:real->bool. negligible s <=> !t. (indicator s has_integral 0) t``,
  GEN_TAC THEN EQ_TAC THENL
   [ALL_TAC, REWRITE_TAC[negligible] THEN SIMP_TAC std_ss []] THEN
  DISCH_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[has_integral_alt] THEN
  COND_CASES_TAC THENL [ASM_MESON_TAC[negligible], ALL_TAC] THEN
  GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC ``&1:real`` THEN REWRITE_TAC[REAL_LT_01] THEN
  REPEAT STRIP_TAC THEN EXISTS_TAC ``0:real`` THEN
  MP_TAC(ISPECL [``s:real->bool``, ``s INTER t:real->bool``]
        NEGLIGIBLE_SUBSET) THEN
  ASM_SIMP_TAC std_ss [INTER_SUBSET, negligible, REAL_SUB_REFL, ABS_0] THEN
  DISCH_TAC THEN POP_ASSUM (MP_TAC o Q.SPECL [`a:real`,`b:real`]) THEN
  SIMP_TAC std_ss [indicator, IN_INTER] THEN MATCH_MP_TAC EQ_IMPLIES THEN
  AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC []);

(* ------------------------------------------------------------------------- *)
(* Finite or empty cases of the spike theorem are quite commonly needed.     *)
(* ------------------------------------------------------------------------- *)

val HAS_INTEGRAL_SPIKE_FINITE = store_thm ("HAS_INTEGRAL_SPIKE_FINITE",
 ``!f:real->real g s t y.
        FINITE s /\ (!x. x IN (t DIFF s) ==> (g x = f x)) /\
        (f has_integral y) t
        ==> (g has_integral y) t``,
  MESON_TAC [HAS_INTEGRAL_SPIKE, NEGLIGIBLE_FINITE]);

val HAS_INTEGRAL_SPIKE_FINITE_EQ = store_thm ("HAS_INTEGRAL_SPIKE_FINITE_EQ",
 ``!f:real->real g s t y.
        FINITE s /\ (!x. x IN (t DIFF s) ==> (g x = f x))
        ==> ((f has_integral y) t <=> (g has_integral y) t)``,
  MESON_TAC[HAS_INTEGRAL_SPIKE_FINITE]);

val INTEGRABLE_SPIKE_FINITE = store_thm ("INTEGRABLE_SPIKE_FINITE",
 ``!f:real->real g s.
        FINITE s /\ (!x. x IN (t DIFF s) ==> (g x = f x))
        ==> f integrable_on t
            ==> g integrable_on  t``,
  REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[integrable_on] THEN
  STRIP_TAC THEN EXISTS_TAC ``y:real`` THEN POP_ASSUM MP_TAC THEN
  MP_TAC(SPEC_ALL HAS_INTEGRAL_SPIKE_FINITE) THEN ASM_REWRITE_TAC[]);

val INTEGRAL_EQ = store_thm ("INTEGRAL_EQ",
 ``!f:real->real g s.
        (!x. x IN s ==> (f x = g x)) ==> (integral s f = integral s g)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN
  EXISTS_TAC ``{}:real->bool`` THEN ASM_SIMP_TAC std_ss [NEGLIGIBLE_EMPTY, IN_DIFF]);

val INTEGRAL_EQ_0 = store_thm ("INTEGRAL_EQ_0",
 ``!f:real->real s. (!x. x IN s ==> (f x = 0)) ==> (integral s f = 0)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
  EXISTS_TAC ``integral s ((\x. 0):real->real)`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC INTEGRAL_EQ THEN ASM_REWRITE_TAC[],
    REWRITE_TAC[INTEGRAL_0]]);

(* ------------------------------------------------------------------------- *)
(* In particular, the boundary of an interval is negligible.                 *)
(* ------------------------------------------------------------------------- *)

val NEGLIGIBLE_FRONTIER_INTERVAL = store_thm ("NEGLIGIBLE_FRONTIER_INTERVAL",
 ``!a b:real. negligible(interval[a,b] DIFF interval(a,b))``,
  REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
  EXISTS_TAC ``BIGUNION ({{x:real | x = (a:real)} UNION
                                 {x:real | x = (b:real)}})`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC NEGLIGIBLE_BIGUNION THEN
    SRW_TAC [][] THEN MATCH_MP_TAC NEGLIGIBLE_UNION THEN
    REWRITE_TAC [NEGLIGIBLE_SING],
    SIMP_TAC std_ss [SUBSET_DEF, IN_DIFF, IN_INTERVAL, IN_BIGUNION, EXISTS_IN_IMAGE] THEN
    SIMP_TAC std_ss [IN_NUMSEG, IN_UNION, GSPECIFICATION, REAL_LT_LE] THEN
    SRW_TAC [][]]);

val HAS_INTEGRAL_SPIKE_INTERIOR = store_thm ("HAS_INTEGRAL_SPIKE_INTERIOR",
 ``!f:real->real g a b y.
        (!x. x IN interval(a,b) ==> (g x = f x)) /\
        (f has_integral y) (interval[a,b])
        ==> (g has_integral y) (interval[a,b])``,
  REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`]
                           HAS_INTEGRAL_SPIKE) THEN
  EXISTS_TAC ``interval[a:real,b] DIFF interval(a,b)`` THEN
  REWRITE_TAC[NEGLIGIBLE_FRONTIER_INTERVAL] THEN ASM_SET_TAC[]);

val HAS_INTEGRAL_SPIKE_INTERIOR_EQ = store_thm ("HAS_INTEGRAL_SPIKE_INTERIOR_EQ",
 ``!f:real->real g a b y.
        (!x. x IN interval(a,b) ==> (g x = f x))
        ==> ((f has_integral y) (interval[a,b]) <=>
             (g has_integral y) (interval[a,b]))``,
  MESON_TAC[HAS_INTEGRAL_SPIKE_INTERIOR]);

val INTEGRABLE_SPIKE_INTERIOR = store_thm ("INTEGRABLE_SPIKE_INTERIOR",
 ``!f:real->real g a b.
        (!x. x IN interval(a,b) ==> (g x = f x))
        ==> f integrable_on (interval[a,b])
            ==> g integrable_on  (interval[a,b])``,
  REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[integrable_on] THEN
  STRIP_TAC THEN EXISTS_TAC ``y:real`` THEN POP_ASSUM MP_TAC THEN
  MP_TAC(SPEC_ALL HAS_INTEGRAL_SPIKE_INTERIOR) THEN ASM_REWRITE_TAC[]);

(* ------------------------------------------------------------------------- *)
(* Integrability of continuous functions.                                    *)
(* ------------------------------------------------------------------------- *)

val NEUTRAL_AND = store_thm ("NEUTRAL_AND",
 ``neutral(/\) = T``,
  SIMP_TAC std_ss [neutral, FORALL_BOOL] THEN METIS_TAC[]);

val MONOIDAL_AND = store_thm ("MONOIDAL_AND",
 ``monoidal(/\)``,
  REWRITE_TAC [monoidal] THEN
  SIMP_TAC std_ss [NEUTRAL_AND, CONJ_ACI]);

val ITERATE_AND = store_thm ("ITERATE_AND",
 ``!p s. FINITE s ==> (iterate(/\) s p <=> !x. x IN s ==> p x)``,
  GEN_TAC THEN
  ONCE_REWRITE_TAC [METIS [] ``!s. ((iterate(/\) s p <=> !x. x IN s ==> p x)) =
                          (\s. (iterate(/\) s p <=> !x. x IN s ==> p x)) s``] THEN
  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
  ASM_SIMP_TAC std_ss [MONOIDAL_AND, NEUTRAL_AND, ITERATE_CLAUSES] THEN SET_TAC[]);

val OPERATIVE_DIVISION_AND = store_thm ("OPERATIVE_DIVISION_AND",
 ``!P d a b. operative(/\) P /\ d division_of interval[a,b]
             ==> ((!i. i IN d ==> P i) <=> P(interval[a,b]))``,
  REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o CONJ MONOIDAL_AND) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP OPERATIVE_DIVISION) THEN
  ASM_MESON_TAC[ITERATE_AND, DIVISION_OF_FINITE]);

val OPERATIVE_APPROXIMABLE = store_thm ("OPERATIVE_APPROXIMABLE",
 ``!f:real->real e.
        &0 <= e
        ==> operative(/\)
               (\i. ?g. (!x. x IN i ==> abs (f x - g x) <= e) /\
                        g integrable_on i)``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[operative, NEUTRAL_AND] THEN CONJ_TAC THENL
   [REPEAT STRIP_TAC THEN BETA_TAC THEN EXISTS_TAC ``f:real->real`` THEN
    ASM_SIMP_TAC std_ss [REAL_SUB_REFL, ABS_0, integrable_on] THEN
    METIS_TAC[HAS_INTEGRAL_NULL],
    ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``, ``c:real``] THEN EQ_TAC THENL
   [METIS_TAC[INTEGRABLE_SPLIT, IN_INTER], ALL_TAC] THEN BETA_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_THEN ``g1:real->real`` STRIP_ASSUME_TAC)
   (X_CHOOSE_THEN ``g2:real->real`` STRIP_ASSUME_TAC)) THEN
  EXISTS_TAC ``\x. if x = c then (f:real->real)(x) else
                   if x <= c then g1(x) else g2(x)`` THEN
  CONJ_TAC THENL
   [GEN_TAC THEN STRIP_TAC THEN SIMP_TAC std_ss [] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL, ABS_0] THEN
    RULE_ASSUM_TAC(SIMP_RULE std_ss [IN_INTER, GSPECIFICATION]) THEN
    METIS_TAC[REAL_ARITH ``x <= c \/ x >= c:real``],
    ALL_TAC] THEN
  SUBGOAL_THEN
   ``(\x:real. if x = c then f x else if x <= c then g1 x else g2 x)
    integrable_on (interval[u,v] INTER {x | x <= c}) /\
    (\x. if x = c then f x :real else if x <= c then g1 x else g2 x)
    integrable_on (interval[u,v] INTER {x | x >= c})``
  MP_TAC THENL
   [ALL_TAC,
    REWRITE_TAC[integrable_on] THEN METIS_TAC[HAS_INTEGRAL_SPLIT]] THEN
  CONJ_TAC THENL
   [UNDISCH_TAC
     ``(g1:real->real) integrable_on (interval[u,v] INTER {x | x <= c})``,
    UNDISCH_TAC
    ``(g2:real->real) integrable_on (interval[u,v] INTER {x | x >= c})``] THEN
  ASM_SIMP_TAC std_ss [INTERVAL_SPLIT] THEN MATCH_MP_TAC INTEGRABLE_SPIKE THEN
  ASM_SIMP_TAC std_ss [GSYM INTERVAL_SPLIT] THEN
  EXISTS_TAC ``{x:real | x = c}`` THEN
  ASM_SIMP_TAC std_ss [NEGLIGIBLE_STANDARD_HYPERPLANE, IN_DIFF, IN_INTER, GSPECIFICATION,
               REAL_ARITH ``x >= c /\ ~(x = c) ==> ~(x <= c:real)``]);

val APPROXIMABLE_ON_DIVISION = store_thm ("APPROXIMABLE_ON_DIVISION",
 ``!f:real->real d a b e.
        &0 <= e /\
        (d division_of interval[a,b]) /\
        (!i. i IN d
             ==> ?g. (!x. x IN i ==> abs (f x - g x) <= e) /\
                     g integrable_on i)
        ==> ?g. (!x. x IN interval[a,b] ==> abs (f x - g x) <= e) /\
                g integrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [``(/\)``, ``d:(real->bool)->bool``,
                 ``a:real``, ``b:real``,
                 ``\i. ?g:real->real.
                       (!x. x IN i ==> abs (f x - g x) <= e) /\
                       g integrable_on i``]
                OPERATIVE_DIVISION) THEN
  ASM_SIMP_TAC std_ss [OPERATIVE_APPROXIMABLE, MONOIDAL_AND] THEN
  DISCH_THEN(SUBST1_TAC o SYM) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
  ASM_SIMP_TAC std_ss [ITERATE_AND]);

val INTEGRABLE_CONTINUOUS = store_thm ("INTEGRABLE_CONTINUOUS",
 ``!f:real->real a b.
        f continuous_on interval[a,b] ==> f integrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_UNIFORM_LIMIT THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  MATCH_MP_TAC APPROXIMABLE_ON_DIVISION THEN
  ASM_SIMP_TAC std_ss [REAL_LT_IMP_LE] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
    COMPACT_UNIFORMLY_CONTINUOUS)) THEN
  REWRITE_TAC[COMPACT_INTERVAL, uniformly_continuous_on] THEN
  DISCH_THEN(MP_TAC o SPEC ``e:real``) THEN ASM_REWRITE_TAC[dist] THEN
  DISCH_THEN(X_CHOOSE_THEN ``d:real`` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   ``?p. p tagged_division_of interval[a:real,b] /\ (\x. ball(x,d)) FINE p``
  STRIP_ASSUME_TAC THENL
   [METIS_TAC[FINE_DIVISION_EXISTS, GAUGE_BALL], ALL_TAC] THEN
  EXISTS_TAC ``IMAGE SND (p:real#(real->bool)->bool)`` THEN
  ASM_SIMP_TAC std_ss [DIVISION_OF_TAGGED_DIVISION] THEN
  SIMP_TAC std_ss [FORALL_IN_IMAGE, FORALL_PROD] THEN
  MAP_EVERY X_GEN_TAC [``x:real``, ``l:real->bool``] THEN
  DISCH_TAC THEN EXISTS_TAC ``\y:real. (f:real->real) x`` THEN
  UNDISCH_TAC `` p tagged_division_of interval [(a,b)]`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [TAGGED_DIVISION_OF]) THEN
  DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
  DISCH_THEN(MP_TAC o
    SPECL [``x:real``, ``l:real->bool``]) THEN
  ASM_REWRITE_TAC[SUBSET_DEF] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  UNDISCH_TAC ``(\x. ball (x,d)) FINE p`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [FINE]) THEN BETA_TAC THEN
  REWRITE_TAC[SUBSET_DEF, IN_BALL, dist] THEN
   FIRST_X_ASSUM SUBST_ALL_TAC THEN REPEAT STRIP_TAC THENL
   [METIS_TAC[REAL_LT_IMP_LE, ABS_SUB],
    REWRITE_TAC[integrable_on] THEN
    EXISTS_TAC ``content(interval[a':real,b']) * (f:real->real) x`` THEN
    REWRITE_TAC[HAS_INTEGRAL_CONST]]);

(* ------------------------------------------------------------------------- *)
(* Specialization of additivity to one dimension.                            *)
(* ------------------------------------------------------------------------- *)

val OPERATIVE_1_LT = store_thm ("OPERATIVE_1_LT",
 ``!op. monoidal op
        ==> !f. operative op f <=>
                (!a b. b <= a ==> (f(interval[a,b]) = neutral op)) /\
                (!a b c. a < c /\ c < b
                         ==> (op (f(interval[a,c])) (f(interval[c,b])) =
                              f(interval[a,b])))``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[operative, CONTENT_EQ_0] THEN
  MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN
  DISCH_TAC THEN
  AP_TERM_TAC THEN SIMP_TAC std_ss [FUN_EQ_THM] THEN X_GEN_TAC ``a:real`` THEN
  AP_TERM_TAC THEN SIMP_TAC std_ss [FUN_EQ_THM] THEN X_GEN_TAC ``b:real`` THEN
  EQ_TAC THEN DISCH_TAC THENL
   [X_GEN_TAC ``c:real`` THEN FIRST_ASSUM(SUBST1_TAC o SPEC ``c:real``) THEN
    DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_TRANS) THEN
    ASM_SIMP_TAC std_ss [INTERVAL_SPLIT, LESS_EQ_REFL, REAL_LT_IMP_LE] THEN
    BINOP_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
    SIMP_TAC std_ss [CONS_11, PAIR_EQ] THEN
    SIMP_TAC std_ss [LESS_EQ_REFL, min_def, max_def] THENL
    [FULL_SIMP_TAC std_ss [GSYM REAL_NOT_LE],
     ASM_SIMP_TAC std_ss [REAL_LE_LT]], ALL_TAC] THEN
  X_GEN_TAC ``c:real`` THEN
  SIMP_TAC std_ss [INTERVAL_SPLIT, LESS_EQ_REFL] THEN
  DISJ_CASES_TAC(REAL_ARITH ``c <= a \/ a < c:real``) THENL
   [SUBGOAL_THEN
     ``(content(interval [(a,min b c)]) = &0) /\
       (interval [(max a c,b)] = interval[a,b])``
    (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC) THENL
     [CONJ_TAC THENL
       [SIMP_TAC std_ss [CONTENT_EQ_0, min_def] THEN METIS_TAC [REAL_LE_TRANS],
        AP_TERM_TAC THEN SIMP_TAC std_ss [CONS_11, PAIR_EQ, max_def] THEN
        METIS_TAC [REAL_LE_ANTISYM]],
      REWRITE_TAC[CONTENT_EQ_0] THEN
      DISCH_THEN(ANTE_RES_THEN SUBST1_TAC) THEN METIS_TAC[monoidal]],
    ALL_TAC] THEN
  DISJ_CASES_TAC(REAL_ARITH ``b <= c \/ c < b:real``) THENL
   [SUBGOAL_THEN
     ``(interval [(a,min b c)] = interval[a,b]) /\
       (content(interval [(max a c,b)]) = &0)``
      (CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THENL
     [CONJ_TAC THENL
       [AP_TERM_TAC THEN SIMP_TAC std_ss [CONS_11, PAIR_EQ] THEN METIS_TAC [min_def],
        SIMP_TAC std_ss [CONTENT_EQ_0, max_def] THEN METIS_TAC [REAL_LE_LT]],
      REWRITE_TAC[CONTENT_EQ_0] THEN
      DISCH_THEN(ANTE_RES_THEN SUBST1_TAC) THEN ASM_MESON_TAC[monoidal]],
    ALL_TAC] THEN
  SUBGOAL_THEN
   ``(min b c = c:real) /\ (max a c = c:real)``
   (fn th => REWRITE_TAC[th] THEN ASM_MESON_TAC[]) THEN
  SIMP_TAC std_ss [LESS_EQ_REFL, min_def, max_def] THEN
  FULL_SIMP_TAC std_ss [GSYM REAL_NOT_LE] THEN
  FULL_SIMP_TAC std_ss [REAL_NOT_LE, REAL_LE_LT]);

val OPERATIVE_1_LE = store_thm ("OPERATIVE_1_LE",
 ``!op. monoidal op
        ==> !f. operative op f <=>
                (!a b. b <= a ==> (f(interval[a,b]) = neutral op)) /\
                (!a b c. a <= c /\ c <= b
                         ==> (op (f(interval[a,c])) (f(interval[c,b])) =
                              f(interval[a,b])))``,
  GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN EQ_TAC THENL
   [ALL_TAC, ASM_SIMP_TAC std_ss [OPERATIVE_1_LT] THEN MESON_TAC[REAL_LT_IMP_LE]] THEN
  REWRITE_TAC[operative, CONTENT_EQ_0] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN
  DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN
  POP_ASSUM (MP_TAC o Q.SPECL [`a:real`,`b:real`]) THEN DISCH_TAC THEN
  X_GEN_TAC ``c:real`` THEN FIRST_ASSUM(SUBST1_TAC o SPEC ``c:real``) THEN
  DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LE_TRANS) THEN
  ASM_SIMP_TAC std_ss [INTERVAL_SPLIT, LESS_EQ_REFL] THEN
  BINOP_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
  SIMP_TAC std_ss [CONS_11, PAIR_EQ] THEN
  SIMP_TAC std_ss [LESS_EQ_REFL, min_def, max_def] THEN
  METIS_TAC [REAL_LE_ANTISYM]);

(* ------------------------------------------------------------------------- *)
(* Special case of additivity we need for the FTC.                           *)
(* ------------------------------------------------------------------------- *)

val ADDITIVE_TAGGED_DIVISION_1 = store_thm ("ADDITIVE_TAGGED_DIVISION_1",
 ``!f:real->real p a b.
        a <= b /\
        p tagged_division_of interval[a,b]
        ==> (sum p
             (\(x,k). f(interval_upperbound k) - f(interval_lowerbound k)) =
            f b - f a)``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL
   [``(+):real->real->real``,
    ``p:(real#(real->bool)->bool)``,
    ``a:real``, ``b:real``,
    ``(\k. if k = {} then 0
          else f(interval_upperbound k) - f(interval_lowerbound k)):
     ((real->bool)->real)``] OPERATIVE_TAGGED_DIVISION) THEN
  ASM_SIMP_TAC std_ss [MONOIDAL_REAL_ADD, OPERATIVE_1_LT, NEUTRAL_REAL_ADD,
               INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND] THEN
  KNOW_TAC ``(!(a' :real) (b' :real).
        b' <= a' ==>
        ((if interval [(a',b')] = ({} :real -> bool) then (0 :real)
          else
            (f :real -> real) (interval_upperbound (interval [(a',b')])) -
            f (interval_lowerbound (interval [(a',b')]))) =
         (0 :
         real))) /\
     (!(a :real) (b :real) (c :real).
        a < c /\ c < b ==>
        ((if interval [(a,c)] = ({} :real -> bool) then (0 :real)
          else
            f (interval_upperbound (interval [(a,c)])) -
            f (interval_lowerbound (interval [(a,c)]))) +
         (if interval [(c,b)] = ({} :real -> bool) then (0 :real)
          else
            f (interval_upperbound (interval [(c,b)])) -
            f (interval_lowerbound (interval [(c,b)]))) =
         if interval [(a,b)] = ({} :real -> bool) then (0 :real)
         else
           f (interval_upperbound (interval [(a,b)])) -
           f (interval_lowerbound (interval [(a,b)]))))`` THENL
   [ASM_SIMP_TAC std_ss [GSYM INTERVAL_EQ_EMPTY, REAL_ARITH ``a <= b ==> ~(b < a:real)``,
                 REAL_LT_IMP_LE, CONTENT_EQ_0,
                 INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND] THEN
    SIMP_TAC std_ss [REAL_ARITH ``b <= a ==> (b < a <=> ~(b = a:real))``] THEN
    SIMP_TAC std_ss [METIS [] ``(if ~p then x else y) = (if p then y else x)``] THEN
    SIMP_TAC std_ss [INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND, REAL_LE_REFL] THEN
    SIMP_TAC std_ss [REAL_SUB_REFL, COND_ID] THEN
    REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_TRANS) THEN
    ASM_SIMP_TAC std_ss [INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND,
                 REAL_ARITH ``b < a ==> ~(a < b:real)``, REAL_LT_IMP_LE] THEN
    MESON_TAC[REAL_ARITH ``(c - a) + (b - c):real = b - a``],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  ASM_SIMP_TAC std_ss [GSYM INTERVAL_EQ_EMPTY, GSYM REAL_NOT_LE] THEN
  DISCH_THEN(SUBST1_TAC o SYM) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
  ASM_SIMP_TAC std_ss [GSYM sum_def] THEN MATCH_MP_TAC SUM_EQ THEN
  SIMP_TAC std_ss [FORALL_PROD] THEN
  METIS_TAC[TAGGED_DIVISION_OF, MEMBER_NOT_EMPTY]);

(* ------------------------------------------------------------------------- *)
(* A useful lemma allowing us to factor out the content size.                *)
(* ------------------------------------------------------------------------- *)

val HAS_INTEGRAL_FACTOR_CONTENT = store_thm ("HAS_INTEGRAL_FACTOR_CONTENT",
 ``!f:real->real i a b.
      (f has_integral i) (interval[a,b]) <=>
      (!e. &0 < e
           ==> ?d. gauge d /\
                   (!p. p tagged_division_of interval[a,b] /\ d FINE p
                        ==> abs (sum p (\(x,k). content k * f x) - i)
                            <= e * content(interval[a,b])))``,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC ``content(interval[a:real,b]) = &0`` THENL
   [MP_TAC(SPECL [``f:real->real``, ``a:real``, ``b:real``]
     SUM_CONTENT_NULL) THEN
    ASM_SIMP_TAC std_ss [HAS_INTEGRAL_NULL_EQ, REAL_SUB_LZERO, ABS_NEG] THEN
    DISCH_TAC THEN REWRITE_TAC[REAL_MUL_RZERO, ABS_LE_0] THEN
    METIS_TAC[FINE_DIVISION_EXISTS, GAUGE_TRIVIAL, REAL_LT_01],
    ALL_TAC] THEN
  REWRITE_TAC[has_integral] THEN EQ_TAC THEN DISCH_TAC THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o SPEC ``e * content(interval[a:real,b])``) THEN
    ASM_SIMP_TAC std_ss [REAL_LT_MUL, CONTENT_LT_NZ] THEN METIS_TAC[REAL_LT_IMP_LE],
    ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2 / content(interval[a:real,b])``) THEN
  ASM_SIMP_TAC arith_ss [REAL_LT_DIV, CONTENT_LT_NZ, REAL_LT] THEN
  ASM_SIMP_TAC std_ss [REAL_DIV_RMUL] THEN
  KNOW_TAC ``!e x:real. &0 < e /\ x <= e / &2 ==> x < e`` THENL
  [SIMP_TAC std_ss [REAL_LE_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
   REAL_ARITH_TAC, DISCH_TAC] THEN METIS_TAC[]);

(* ------------------------------------------------------------------------- *)
(* Attempt a systematic general set of "offset" results for components.      *)
(* ------------------------------------------------------------------------- *)

val GAUGE_MODIFY = store_thm ("GAUGE_MODIFY",
 ``!f:real->real.
      (!s. open s ==> open {x | f(x) IN s})
      ==> !d. gauge d ==> gauge (\x y. d (f x) (f y))``,
  GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
  SIMP_TAC std_ss [gauge_def, IN_DEF] THEN DISCH_TAC THEN
  X_GEN_TAC ``x:real`` THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``(f:real->real) x``) THEN
  DISCH_THEN(ANTE_RES_THEN MP_TAC o CONJUNCT2) THEN
  MATCH_MP_TAC EQ_IMPLIES THEN
  AP_TERM_TAC THEN SIMP_TAC std_ss [EXTENSION, GSPECIFICATION] THEN
  SIMP_TAC std_ss [IN_DEF]);

(* ------------------------------------------------------------------------- *)
(* Integrabibility on subintervals.                                          *)
(* ------------------------------------------------------------------------- *)

val OPERATIVE_INTEGRABLE = store_thm ("OPERATIVE_INTEGRABLE",
 ``!f. operative (/\) (\i. f integrable_on i)``,
  GEN_TAC THEN REWRITE_TAC[operative, NEUTRAL_AND] THEN CONJ_TAC THENL
   [REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_NULL_EQ],
    REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC std_ss [INTEGRABLE_SPLIT] THEN
    REWRITE_TAC[integrable_on] THEN METIS_TAC[HAS_INTEGRAL_SPLIT]]);

val INTEGRABLE_SUBINTERVAL = store_thm ("INTEGRABLE_SUBINTERVAL",
 ``!f:real->real a b c d.
        f integrable_on interval[a,b] /\
        interval[c,d] SUBSET interval[a,b]
        ==> f integrable_on interval[c,d]``,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC ``interval[c:real,d] = {}`` THENL
   [ASM_REWRITE_TAC[integrable_on] THEN
    METIS_TAC[HAS_INTEGRAL_NULL, CONTENT_EMPTY, EMPTY_AS_INTERVAL],
    METIS_TAC[OPERATIVE_INTEGRABLE, OPERATIVE_DIVISION_AND,
                  PARTIAL_DIVISION_EXTEND_1]]);

(* ------------------------------------------------------------------------- *)
(* Combining adjacent intervals in 1 dimension.                              *)
(* ------------------------------------------------------------------------- *)

val HAS_INTEGRAL_COMBINE = store_thm ("HAS_INTEGRAL_COMBINE",
 ``!f i:real j a b c.
        a <= c /\ c <= b /\
        (f has_integral i) (interval[a,c]) /\
        (f has_integral j) (interval[c,b])
        ==> (f has_integral (i + j)) (interval[a,b])``,
  REPEAT STRIP_TAC THEN MP_TAC
   ((CONJUNCT2 o REWRITE_RULE
     [MATCH_MP OPERATIVE_1_LE(MATCH_MP MONOIDAL_LIFTED MONOIDAL_REAL_ADD)])
    (ISPEC ``f:real->real`` OPERATIVE_INTEGRAL)) THEN
  DISCH_THEN(MP_TAC o SPECL [``a:real``, ``b:real``, ``c:real``]) THEN
  ASM_REWRITE_TAC[] THEN BETA_TAC THEN
  REPEAT(COND_CASES_TAC THEN
   ASM_SIMP_TAC std_ss [lifted, NOT_NONE_SOME, SOME_11, option_CLAUSES]) THEN
  METIS_TAC[INTEGRABLE_INTEGRAL, HAS_INTEGRAL_UNIQUE, integrable_on,
                INTEGRAL_UNIQUE]);

val INTEGRAL_COMBINE = store_thm ("INTEGRAL_COMBINE",
 ``!f:real->real a b c.
        a <= c /\ c <= b /\ f integrable_on (interval[a,b])
        ==> (integral(interval[a,c]) f + integral(interval[c,b]) f =
             integral(interval[a,b]) f)``,
  REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
  MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_COMBINE THEN
  EXISTS_TAC ``c:real`` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN
  MATCH_MP_TAC INTEGRABLE_INTEGRAL THEN
  MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN
  MAP_EVERY EXISTS_TAC [``a:real``, ``b:real``] THEN
  ASM_REWRITE_TAC[SUBSET_INTERVAL, REAL_LE_REFL]);

val INTEGRABLE_COMBINE = store_thm ("INTEGRABLE_COMBINE",
 ``!f a b c.
        a <= c /\ c <= b /\
        f integrable_on interval[a,c] /\
        f integrable_on interval[c,b]
        ==> f integrable_on interval[a,b]``,
  REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_COMBINE]);

(* ------------------------------------------------------------------------- *)
(* Reduce integrability to "local" integrability.                            *)
(* ------------------------------------------------------------------------- *)

val INTEGRABLE_ON_LITTLE_SUBINTERVALS = store_thm ("INTEGRABLE_ON_LITTLE_SUBINTERVALS",
 ``!f:real->real a b.
        (!x. x IN interval[a,b]
             ==> ?d. &0 < d /\
                     !u v. x IN interval[u,v] /\
                           interval[u,v] SUBSET ball(x,d) /\
                           interval[u,v] SUBSET interval[a,b]
                           ==> f integrable_on interval[u,v])
        ==> f integrable_on interval[a,b]``,
  REPEAT GEN_TAC THEN
  SIMP_TAC std_ss [RIGHT_IMP_EXISTS_THM, GAUGE_EXISTENCE_LEMMA] THEN
  SIMP_TAC std_ss [SKOLEM_THM, FORALL_AND_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN ``d:real->real`` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL [``\x:real. ball(x,d x)``, ``a:real``, ``b:real``]
                FINE_DIVISION_EXISTS) THEN
  ASM_SIMP_TAC std_ss [GAUGE_BALL_DEPENDENT, LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC ``p:real#(real->bool)->bool`` THEN STRIP_TAC THEN
  MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] OPERATIVE_DIVISION_AND)
         (ISPEC ``f:real->real`` OPERATIVE_INTEGRABLE)) THEN
  DISCH_THEN(MP_TAC o SPECL
   [``IMAGE SND (p:real#(real->bool)->bool)``, ``a:real``, ``b:real``]) THEN
  ASM_SIMP_TAC std_ss [DIVISION_OF_TAGGED_DIVISION] THEN
  DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN
  SIMP_TAC std_ss [FORALL_PROD] THEN
  MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN DISCH_TAC THEN
  UNDISCH_TAC `` p tagged_division_of interval [(a,b)]`` THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o REWRITE_RULE [TAGGED_DIVISION_OF]) THEN
  STRIP_TAC THEN UNDISCH_TAC `` !(x :real) (k :real -> bool).
            (x,k) IN (p :real # (real -> bool) -> bool) ==>
            x IN k /\ k SUBSET interval [((a :real),(b :real))] /\
            ?(a :real) (b :real). k = interval [(a,b)]`` THEN
  UNDISCH_TAC ``(\x. ball (x,d x)) FINE p`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [FINE]) THEN
  SIMP_TAC std_ss [AND_IMP_INTRO, GSYM FORALL_AND_THM] THEN
  DISCH_THEN(MP_TAC o SPECL [``x:real``, ``k:real->bool``]) THEN
  ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SUBSET_DEF]);

(* ------------------------------------------------------------------------- *)
(* Second FCT or existence of antiderivative.                                *)
(* ------------------------------------------------------------------------- *)

val INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE = store_thm ("INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE",
 ``!f:real->real a b x.
        f integrable_on interval[a,b] /\ x IN interval[a,b] /\
        f continuous (at x within interval[a,b])
        ==> ((\u. integral (interval [a,u]) f) has_vector_derivative f x)
            (at x within interval [a,b])``,
  REWRITE_TAC[IN_INTERVAL] THEN REPEAT STRIP_TAC THEN
  REWRITE_TAC[has_vector_derivative, HAS_DERIVATIVE_WITHIN_ALT] THEN
  CONJ_TAC THENL
   [SIMP_TAC std_ss [linear] THEN
    CONJ_TAC THEN REAL_ARITH_TAC,
    ALL_TAC] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN
  UNDISCH_TAC ``f continuous (at x within interval [(a,b)])`` THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o REWRITE_RULE [continuous_within]) THEN
  DISCH_THEN(MP_TAC o SPEC ``e:real``) THEN
  ASM_REWRITE_TAC[IN_INTERVAL, dist] THEN
  STRIP_TAC THEN EXISTS_TAC ``d:real`` THEN
  ASM_REWRITE_TAC[] THEN X_GEN_TAC ``y:real`` THEN STRIP_TAC THEN
  SIMP_TAC std_ss [] THEN
  DISJ_CASES_TAC(REAL_ARITH ``x <= y \/ y <= x:real``) THENL
   [ASM_SIMP_TAC std_ss [REAL_ARITH ``x <= y ==> (abs(y - x) = y - x:real)``],
    ONCE_REWRITE_TAC[REAL_ARITH
     ``fy - fx - (x - y) * c:real = -(fx - fy - (y - x) * c)``] THEN
    ASM_SIMP_TAC std_ss [ABS_NEG, REAL_ARITH ``x <= y ==> (abs(x - y) = y - x:real)``]] THEN
  ASM_SIMP_TAC std_ss [GSYM CONTENT_CLOSED_INTERVAL] THEN MATCH_MP_TAC HAS_INTEGRAL_BOUND THEN
  EXISTS_TAC ``(\u. f(u) - f(x)):real->real`` THEN
  (ASM_SIMP_TAC std_ss [REAL_LT_IMP_LE] THEN CONJ_TAC THENL
   [ALL_TAC,
    REPEAT STRIP_TAC THEN
    MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    REPEAT(POP_ASSUM MP_TAC) THEN
    SIMP_TAC std_ss [IN_INTERVAL] THEN
    REAL_ARITH_TAC] THEN
   ONCE_REWRITE_TAC [METIS [] ``(\u:real. f u - (f:real->real) x) = (\u:real. f u - (\u. f x) u)``] THEN
   MATCH_MP_TAC HAS_INTEGRAL_SUB THEN REWRITE_TAC[HAS_INTEGRAL_CONST]) THENL
    [SUBGOAL_THEN
      ``(integral(interval[a,x]) f + integral(interval[x,y]) f =
         integral(interval[a,y]) f) /\
       ((f:real->real) has_integral integral(interval[x,y]) f)
        (interval[x,y])``
      (fn th => METIS_TAC[th,
          REAL_ARITH ``(a + b = c:real) ==> (c - a = b:real)``]),
     SUBGOAL_THEN
      ``(integral(interval[a,y]) f + integral(interval[y,x]) f =
         integral(interval[a,x]) f) /\
       ((f:real->real) has_integral integral(interval[y,x]) f)
        (interval[y,x])``
       (fn th => METIS_TAC[th,
         REAL_ARITH ``(a + b = c:real) ==> (c - a = b:real)``])] THEN
   (CONJ_TAC THENL
     [MATCH_MP_TAC INTEGRAL_COMBINE,
      MATCH_MP_TAC INTEGRABLE_INTEGRAL] THEN
    ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN
    MAP_EVERY EXISTS_TAC [``a:real``, ``b:real``] THEN
    ASM_SIMP_TAC std_ss [INTEGRABLE_CONTINUOUS, SUBSET_INTERVAL, REAL_LE_REFL] THEN
    ASM_REAL_ARITH_TAC));

val INTEGRAL_HAS_VECTOR_DERIVATIVE = store_thm ("INTEGRAL_HAS_VECTOR_DERIVATIVE",
 ``!f:real->real a b.
     f continuous_on interval[a,b]
     ==> !x. x IN interval[a,b]
             ==> ((\u. integral (interval[a,u]) f) has_vector_derivative f(x))
                 (at x within interval[a,b])``,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE THEN
  ASM_MESON_TAC[INTEGRABLE_CONTINUOUS, CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]);

val ANTIDERIVATIVE_CONTINUOUS = store_thm ("ANTIDERIVATIVE_CONTINUOUS",
 ``!f:real->real a b.
     f continuous_on interval[a,b]
     ==> ?g. !x. x IN interval[a,b]
                 ==> (g has_vector_derivative f(x))
                          (at x within interval[a,b])``,
  METIS_TAC[INTEGRAL_HAS_VECTOR_DERIVATIVE]);

(* ------------------------------------------------------------------------- *)
(* General "twiddling" for interval-to-interval function image.              *)
(* ------------------------------------------------------------------------- *)

val lemma0 = prove (
  ``(!x k. (x,k) IN IMAGE (\(x,k). f x,g k) p ==> P x k) <=>
    (!x k. (x,k) IN p ==> P (f x) (g k))``,
    SIMP_TAC std_ss [IN_IMAGE, EXISTS_PROD, PAIR_EQ] THEN MESON_TAC[]);

val lemma1 = prove (
  ``{k | ?x. (x,k) IN p} = IMAGE SND p``,
    SIMP_TAC std_ss [EXTENSION, EXISTS_PROD, IN_IMAGE, GSPECIFICATION] THEN
    MESON_TAC[]);

val lemma2 = prove (
  ``(SND o (\(x,k). f x,g k)) = (g o SND)``,
    SIMP_TAC std_ss [FUN_EQ_THM, FORALL_PROD, o_DEF]);

val HAS_INTEGRAL_TWIDDLE = store_thm ("HAS_INTEGRAL_TWIDDLE",
 ``!f:real->real (g:real->real) h r i a b.
      &0 < r /\
      (!x. h(g x) = x) /\ (!x. g(h x) = x) /\ (!x. g continuous at x) /\
      (!u v. ?w z. IMAGE g (interval[u,v]) = interval[w,z]) /\
      (!u v. ?w z. IMAGE h (interval[u,v]) = interval[w,z]) /\
      (!u v. content(IMAGE g (interval[u,v])) = r * content(interval[u,v])) /\
      (f has_integral i) (interval[a,b])
      ==> ((\x. f(g x)) has_integral (inv r) * i) (IMAGE h (interval[a,b]))``,
  REPEAT GEN_TAC THEN ASM_CASES_TAC ``interval[a:real,b] = {}`` THEN
  ASM_SIMP_TAC std_ss [IMAGE_EMPTY, IMAGE_INSERT, HAS_INTEGRAL_EMPTY_EQ, REAL_MUL_RZERO] THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  REWRITE_TAC[has_integral] THEN
  ASM_REWRITE_TAC[has_integral_def, has_integral_compact_interval] THEN
  DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``e * r:real``) THEN
  ASM_SIMP_TAC std_ss [REAL_LT_MUL] THEN
  DISCH_THEN(X_CHOOSE_THEN ``d:real->real->bool`` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC ``\x y:real. (d:real->real->bool) (g x) (g y)`` THEN
  CONJ_TAC THENL
   [UNDISCH_TAC ``gauge d`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [gauge_def]) THEN
    SIMP_TAC std_ss [gauge_def, IN_DEF, FORALL_AND_THM] THEN
    STRIP_TAC THEN X_GEN_TAC ``x:real`` THEN
    SUBGOAL_THEN ``(\y:real. (d:real->real->bool) (g x) (g y)) =
                  {y | g y IN (d (g x))}`` SUBST1_TAC
    THENL [SET_TAC[], ASM_SIMP_TAC std_ss [CONTINUOUS_OPEN_PREIMAGE_UNIV]],
    ALL_TAC] THEN
  X_GEN_TAC ``p:real#(real->bool)->bool`` THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC
   ``IMAGE (\(x,k). (g:real->real) x, IMAGE g k) p``) THEN
  KNOW_TAC ``IMAGE (\((x :real),(k :real -> bool)). ((g :real -> real) x,IMAGE g k))
       (p :real # (real -> bool) -> bool) tagged_division_of
     interval [((a :real),(b :real))] /\
     (d :real -> real -> bool) FINE
     IMAGE (\((x :real),(k :real -> bool)). (g x,IMAGE g k)) p `` THENL
   [CONJ_TAC THENL
     [ALL_TAC,
      UNDISCH_TAC ``(\(x :real) (y :real).
              (d :real -> real -> bool) ((g :real -> real) x) (g y)) FINE
           (p :real # (real -> bool) -> bool)`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [FINE]) THEN
      SIMP_TAC std_ss [FINE, lemma0] THEN
      STRIP_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN
      ASM_SET_TAC[]] THEN
    SUBGOAL_THEN
     ``interval[a,b] = IMAGE ((g:real->real) o h) (interval[a,b])``
    SUBST1_TAC THENL [SIMP_TAC std_ss [o_DEF] THEN ASM_SET_TAC[], ALL_TAC] THEN
    SUBGOAL_THEN ``?u v. IMAGE (h:real->real) (interval[a,b]) =
                        interval[u,v]``
    (REPEAT_TCL CHOOSE_THEN
      (fn th => SUBST_ALL_TAC th THEN ASSUME_TAC th)) THENL
      [METIS_TAC[], ALL_TAC] THEN
    UNDISCH_TAC ``p tagged_division_of interval [(u,v)]`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [TAGGED_DIVISION_OF]) THEN
    SIMP_TAC std_ss [TAGGED_DIVISION_OF, IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
    SIMP_TAC std_ss [lemma0] THEN REWRITE_TAC[AND_IMP_INTRO, GSYM CONJ_ASSOC] THEN
    REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL
     [ASM_SIMP_TAC std_ss [IMAGE_FINITE], ALL_TAC] THEN
    CONJ_TAC THENL
     [MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN
      DISCH_TAC THEN
      UNDISCH_TAC
       `` !x:real k.
             (x,k) IN p ==>
             x IN k /\ k SUBSET interval [(u,v)] /\
             ?a b. k = interval [(a,b)]`` THEN
      DISCH_THEN(MP_TAC o SPECL [``x:real``, ``k:real->bool``]) THEN
      ASM_SIMP_TAC std_ss [] THEN
      REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL
       [SET_TAC[],
        REWRITE_TAC[IMAGE_COMPOSE] THEN ASM_SET_TAC[],
        STRIP_TAC THEN ASM_REWRITE_TAC[]],
      ALL_TAC] THEN
    CONJ_TAC THENL
     [ALL_TAC,
      ASM_REWRITE_TAC[IMAGE_COMPOSE] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
      SIMP_TAC std_ss [lemma1, GSYM IMAGE_COMPOSE, lemma2] THEN
      METIS_TAC [IMAGE_COMPOSE, GSYM IMAGE_BIGUNION, ETA_AX]] THEN
    MAP_EVERY X_GEN_TAC [``x1:real``, ``k1:real->bool``] THEN DISCH_TAC THEN
    ONCE_REWRITE_TAC [REAL_ARITH ``(a <> b) = ~(a = b:real)``, GSYM DE_MORGAN_THM] THEN
    MAP_EVERY X_GEN_TAC [``x2:real``, ``k2:real->bool``] THEN
    DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o REWRITE_RULE [GSYM PAIR_EQ])) THEN
    DISCH_TAC THEN
    UNDISCH_TAC
     ``!x1:real k1:real->bool.
              (x1,k1) IN p ==>
             !x2 k2.
               (x2,k2) IN p /\ (x1 <> x2 \/ k1 <> k2) ==>
               (interior k1 INTER interior k2 = {})`` THEN
    DISCH_THEN(MP_TAC o SPECL [``x1:real``, ``k1:real->bool``]) THEN
    ASM_REWRITE_TAC[] THEN
    DISCH_THEN(MP_TAC o SPECL [``x2:real``, ``k2:real->bool``]) THEN
    ASM_REWRITE_TAC[] THEN
    KNOW_TAC ``((x1 :real) <> (x2 :real)) \/
               ((k1 :real -> bool) <> (k2 :real -> bool))`` THENL
     [METIS_TAC[PAIR_EQ], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    MATCH_MP_TAC(SET_RULE
     ``interior(IMAGE f s) SUBSET IMAGE f (interior s) /\
      interior(IMAGE f t) SUBSET IMAGE f (interior t) /\
      (!x y. (f x = f y) ==> (x = y))
      ==> (interior s INTER interior t = {})
          ==> (interior(IMAGE f s) INTER interior(IMAGE f t) = {})``) THEN
    REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC INTERIOR_IMAGE_SUBSET) THEN
    ASM_MESON_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  W(fn (asl,w) => MP_TAC(PART_MATCH (lhand o rand) SUM_IMAGE
                (lhand(rand(lhand(lhand w)))))) THEN
  KNOW_TAC ``(!(x :real # (real -> bool)) (y :real # (real -> bool)).
        x IN (p :real # (real -> bool) -> bool) /\ y IN p /\
        ((\((x :real),(k :real -> bool)). ((g :real -> real) x,IMAGE g k))
           x =
         (\((x :real),(k :real -> bool)). (g x,IMAGE g k)) y) ==>
        (x = y))`` THENL
   [FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
    ASM_SIMP_TAC std_ss [FORALL_PROD, PAIR_EQ] THEN
    REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN ASM_SET_TAC[],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  DISCH_THEN SUBST1_TAC THEN SIMP_TAC std_ss [o_DEF, LAMBDA_PROD] THEN
  DISCH_TAC THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN
  EXISTS_TAC ``abs r:real`` THEN ASM_SIMP_TAC std_ss [REAL_ARITH ``&0 < x ==> &0 < abs x:real``] THEN
  REWRITE_TAC[GSYM ABS_MUL] THEN ASM_SIMP_TAC std_ss [REAL_LT_IMP_LE,
   REAL_ARITH ``0 < r ==> (abs r = r:real)``] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
   ``x < a * b ==> (x = y) ==> y < b * a:real``)) THEN
  AP_TERM_TAC THEN REWRITE_TAC[REAL_SUB_LDISTRIB] THEN
  ASM_SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_MUL_RINV, REAL_LT_IMP_NE] THEN
  REWRITE_TAC[REAL_MUL_LID, GSYM SUM_LMUL] THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN
  SIMP_TAC std_ss [FORALL_PROD, REAL_MUL_ASSOC] THEN
  REPEAT STRIP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
  METIS_TAC[TAGGED_DIVISION_OF]);

(* ------------------------------------------------------------------------- *)
(* Special case of a basic affine transformation.                            *)
(* ------------------------------------------------------------------------- *)

val INTERVAL_IMAGE_AFFINITY_INTERVAL = store_thm ("INTERVAL_IMAGE_AFFINITY_INTERVAL",
 ``!a b m c. ?u v. IMAGE (\x. m * x + c) (interval[a,b]) = interval[u,v]``,
  REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN
  METIS_TAC[EMPTY_AS_INTERVAL]);

val CONTENT_IMAGE_AFFINITY_INTERVAL = store_thm ("CONTENT_IMAGE_AFFINITY_INTERVAL",
 ``!a b:real m c.
        content(IMAGE (\x. m * x + c) (interval[a,b])) =
        (abs m) pow (1:num) * content(interval[a,b])``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[CONTENT_EMPTY, REAL_MUL_RZERO] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN COND_CASES_TAC THEN
  W(fn (asl,w) => MP_TAC(PART_MATCH (lhand o rand) CONTENT_CLOSED_INTERVAL
                (lhs w))) THENL
  [KNOW_TAC ``m * a + c <= m * b + c:real`` THENL
     [MATCH_MP_TAC REAL_LE_ADD2 THEN REWRITE_TAC [REAL_LE_REFL] THEN
      MATCH_MP_TAC REAL_LE_LMUL_IMP THEN ASM_REWRITE_TAC [],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC std_ss [abs, CONTENT_CLOSED_INTERVAL, POW_1] THEN
  REAL_ARITH_TAC, ALL_TAC] THEN
   KNOW_TAC ``m * b + c <= m * a + c:real`` THENL
   [MATCH_MP_TAC REAL_LE_ADD2 THEN REWRITE_TAC [REAL_LE_REFL] THEN
    ONCE_REWRITE_TAC[REAL_ARITH ``m * b <= m * a <=> -m * a <= -m * b:real``] THEN
    MATCH_MP_TAC REAL_LE_LMUL_IMP THEN ASM_REAL_ARITH_TAC,
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    DISCH_THEN SUBST1_TAC THEN
        ASM_SIMP_TAC std_ss [abs, CONTENT_CLOSED_INTERVAL, POW_1] THEN
    REAL_ARITH_TAC);

val HAS_INTEGRAL_AFFINITY = store_thm ("HAS_INTEGRAL_AFFINITY",
 ``!f:real->real i a b m c.
        (f has_integral i) (interval[a,b]) /\ ~(m = &0)
        ==> ((\x. f(m * x + c)) has_integral
             (inv(abs(m) pow (1:num)) * i))
            (IMAGE (\x. inv m * x + -(inv(m) * c)) (interval[a,b]))``,
  REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC [METIS [] ``(m * x + c) = (\x:real. (m * x + c)) x``] THEN
  MATCH_MP_TAC HAS_INTEGRAL_TWIDDLE THEN
  ASM_SIMP_TAC std_ss [INTERVAL_IMAGE_AFFINITY_INTERVAL, GSYM ABS_NZ,
        REAL_POW_LT, CONTENT_IMAGE_AFFINITY_INTERVAL] THEN
  ASM_SIMP_TAC std_ss [CONTINUOUS_CMUL, CONTINUOUS_AT_ID, CONTINUOUS_CONST,
                       CONTINUOUS_ADD] THEN
  REWRITE_TAC[REAL_ADD_LDISTRIB, REAL_MUL_ASSOC, REAL_MUL_RNEG] THEN
  ASM_SIMP_TAC std_ss [REAL_MUL_LINV, REAL_MUL_RINV] THEN
  CONJ_TAC THEN REAL_ARITH_TAC);

val INTEGRABLE_AFFINITY = store_thm ("INTEGRABLE_AFFINITY",
 ``!f:real->real a b m c.
        f integrable_on interval[a,b] /\ ~(m = &0)
        ==> (\x. f(m * x + c)) integrable_on
            (IMAGE (\x. inv m * x + -(inv(m) * c)) (interval[a,b]))``,
  REWRITE_TAC[integrable_on] THEN METIS_TAC[HAS_INTEGRAL_AFFINITY]);

(* ------------------------------------------------------------------------- *)
(* Special case of stretching coordinate axes separately.                    *)
(* ------------------------------------------------------------------------- *)

Theorem CONTENT_IMAGE_STRETCH_INTERVAL :
    !a b:real m.
        content(IMAGE (\x. m 1 * x) (interval[a,b]):real->bool) =
        abs(product((1:num)..(1:num)) m) * content(interval[a,b])
Proof
    rpt GEN_TAC >> REWRITE_TAC [content, IMAGE_EQ_EMPTY]
 >> COND_CASES_TAC >> ASM_REWRITE_TAC [REAL_MUL_RZERO]
 >> ASM_SIMP_TAC std_ss [SIMP_RULE std_ss [] IMAGE_STRETCH_INTERVAL]
 >> RULE_ASSUM_TAC (REWRITE_RULE [INTERVAL_NE_EMPTY])
(* TODO: a common lemma between min,max *)
 >> Know `!x:real y. min x y <= max x y`
 >- (RW_TAC std_ss [min_def, max_def] \\
     MATCH_MP_TAC REAL_LT_IMP_LE >> fs [real_lte])
 >> DISCH_THEN (ASSUME_TAC o (Q.SPECL [`(m :num->real) 1 * a`,
                                       `(m :num->real) 1 * b`]))
 >> ASM_SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_LOWERBOUND]
(* TODO: a common lemma between min,max,abs *)
 >> Know `!x:real y. max x y - min x y = abs (y - x)`
 >- (RW_TAC real_ss [min_def, max_def, abs] >> REAL_ASM_ARITH_TAC)
 >> Rewr'
 >> ASM_REWRITE_TAC [GSYM REAL_SUB_LDISTRIB, ABS_MUL]
 >> ASM_SIMP_TAC std_ss [NUMSEG_SING, PRODUCT_SING, FINITE_NUMSEG,
                         REAL_ARITH ``a <= b ==> (abs(b - a) = b - a:real)``]
QED

Theorem HAS_INTEGRAL_STRETCH :
    !f:real->real i m a b.
        (f has_integral i) (interval[a,b]) /\
        ~(m (1:num) = &0)
        ==> ((\x:real. f(m (1:num) * x)) has_integral
             (inv(abs(product((1:num)..(1:num)) m)) * i))
            (IMAGE (\x. inv(m 1) * x) (interval[a,b]))
Proof
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_TWIDDLE THEN
  SIMP_TAC std_ss [] THEN
  ASM_SIMP_TAC real_ss [REAL_MUL_ASSOC, REAL_MUL_LINV, REAL_MUL_RINV, REAL_MUL_LID] THEN
  ASM_SIMP_TAC real_ss [GSYM ABS_NZ, PRODUCT_EQ_0_NUMSEG] THEN
  CONJ_TAC THENL [GEN_TAC THEN ASM_CASES_TAC ``x = 1:num`` THENL
   [ASM_SIMP_TAC arith_ss [], ALL_TAC] THEN
   ONCE_REWRITE_TAC [TAUT `a \/ b \/ c <=> c \/ a \/ b`] THEN DISJ2_TAC THEN
   POP_ASSUM MP_TAC THEN SIMP_TAC arith_ss [NOT_LESS_EQUAL], ALL_TAC] THEN
  CONJ_TAC THENL
   [GEN_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
    SIMP_TAC std_ss [linear] THEN REAL_ARITH_TAC, ALL_TAC] THEN
   KNOW_TAC ``!(u :real) (v :real).
  content (IMAGE ($* (m (1 :num))) (interval [(u,v)])) =
  abs (product ((1 :num) .. (1 :num)) m) * content (interval [(u,v)])`` THENL
   [SIMP_TAC std_ss [GSYM CONTENT_IMAGE_STRETCH_INTERVAL] THEN
    METIS_TAC [], DISCH_TAC] THEN ASM_REWRITE_TAC [] THEN
   REPEAT STRIP_TAC THENL
   [ALL_TAC,
    SIMP_TAC std_ss [SIMP_RULE std_ss [] IMAGE_STRETCH_INTERVAL] THEN
    METIS_TAC[EMPTY_AS_INTERVAL]] THEN
    METIS_TAC [SIMP_RULE std_ss [] IMAGE_STRETCH_INTERVAL]
QED

val INTEGRABLE_STRETCH = store_thm ("INTEGRABLE_STRETCH",
 ``!f:real->real m a b.
        f integrable_on interval[a,b] /\ ~(m (1:num) = &0)
        ==> (\x:real. f(m (1:num) * x)) integrable_on
            (IMAGE (\x. inv(m 1) * x) (interval[a,b]))``,
  REWRITE_TAC[integrable_on] THEN METIS_TAC[HAS_INTEGRAL_STRETCH]);

(* ------------------------------------------------------------------------- *)
(* Even more special cases.                                                  *)
(* ------------------------------------------------------------------------- *)

val HAS_INTEGRAL_REFLECT_LEMMA = store_thm ("HAS_INTEGRAL_REFLECT_LEMMA",
 ``!f:real->real i a b.
     (f has_integral i) (interval[a,b])
     ==> ((\x. f(-x)) has_integral i) (interval[-b,-a])``,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o C CONJ (REAL_ARITH ``~(- &1 = &0:real)``)) THEN
  DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_AFFINITY) THEN
  DISCH_THEN(MP_TAC o SPEC ``0:real``) THEN
  REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN
  SIMP_TAC std_ss [REAL_MUL_RZERO, ABS_NEG, ABS_1] THEN
  KNOW_TAC ``~(&0 <= inv (- &1:real))`` THENL
  [KNOW_TAC ``-1 <> 0:real`` THENL [REAL_ARITH_TAC, DISCH_TAC] THEN
   REWRITE_TAC [REAL_NOT_LE] THEN
   ONCE_REWRITE_TAC [GSYM REAL_LT_NEG] THEN ASM_SIMP_TAC std_ss [REAL_NEG_INV] THEN
   SIMP_TAC std_ss [REAL_NEG_NEG, REAL_NEG_0, REAL_INV1] THEN REAL_ARITH_TAC,
   DISCH_TAC] THEN FULL_SIMP_TAC std_ss [] THEN
  KNOW_TAC ``inv (-1) = -1:real`` THENL
  [KNOW_TAC ``-1 <> 0:real`` THENL [REAL_ARITH_TAC, DISCH_TAC] THEN
   ONCE_REWRITE_TAC [GSYM REAL_EQ_NEG] THEN ASM_SIMP_TAC std_ss [REAL_NEG_INV] THEN
   SIMP_TAC std_ss [REAL_NEG_NEG, REAL_NEG_0, REAL_INV1] THEN REAL_ARITH_TAC,
   DISCH_TAC] THEN
  ASM_REWRITE_TAC[ABS_NEG, ABS_N, POW_ONE] THEN
  REWRITE_TAC[REAL_MUL_RZERO, REAL_NEG_0] THEN
  REWRITE_TAC[REAL_NEG_INV, REAL_INV1] THEN
  REWRITE_TAC[REAL_ARITH ``- &1 * x + 0 = -x:real``] THEN
  REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC EQ_IMPLIES THEN
  AP_TERM_TAC THEN POP_ASSUM(K ALL_TAC) THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN
  POP_ASSUM MP_TAC THEN SIMP_TAC std_ss [GSYM INTERVAL_EQ_EMPTY] THEN
  REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN
  SIMP_TAC std_ss [REAL_LT_NEG]);

val HAS_INTEGRAL_REFLECT = store_thm ("HAS_INTEGRAL_REFLECT",
 ``!f:real->real i a b.
     ((\x. f(-x)) has_integral i) (interval[-b,-a]) <=>
     (f has_integral i) (interval[a,b])``,
  REPEAT GEN_TAC THEN EQ_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_REFLECT_LEMMA) THEN
  SIMP_TAC std_ss [REAL_NEG_NEG, ETA_AX]);

val INTEGRABLE_REFLECT = store_thm ("INTEGRABLE_REFLECT",
 ``!f:real->real a b.
     (\x. f(-x)) integrable_on (interval[-b,-a]) <=>
     f integrable_on (interval[a,b])``,
  SIMP_TAC std_ss [integrable_on, HAS_INTEGRAL_REFLECT]);

val INTEGRAL_REFLECT = store_thm ("INTEGRAL_REFLECT",
 ``!f:real->real a b.
     integral (interval[-b,-a]) (\x. f(-x)) =
     integral (interval[a,b]) f``,
  SIMP_TAC std_ss [integral, HAS_INTEGRAL_REFLECT]);

(* ------------------------------------------------------------------------- *)
(* Technical lemmas about how many non-trivial intervals of a division a     *)
(* point can be in (we sometimes need this for bounding sums).               *)
(* ------------------------------------------------------------------------- *)

val lemma = prove (
  ``!f s. (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) /\
           FINITE s /\ CARD(IMAGE f s) <= n
           ==> CARD(s) <= n``,
    MESON_TAC[CARD_IMAGE_INJ]);

Theorem DIVISION_COMMON_POINT_BOUND :
    !d s:real->bool x.
        d division_of s
        ==> CARD {k | k IN d /\ ~(content k = &0) /\ x IN k}
            <= 2 EXP (1:num)
Proof
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN ``!k. k IN d ==> ?a b:real. interval[a,b] = k`` MP_TAC THENL
   [ASM_MESON_TAC[division_of], ALL_TAC] THEN
  SIMP_TAC std_ss [RIGHT_IMP_EXISTS_THM, SKOLEM_THM, LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC
   [``A:(real->bool)->real``, ``B:(real->bool)->real``] THEN
  STRIP_TAC THEN MATCH_MP_TAC(ISPEC
   ``\d. ((x:real) = (A:(real->bool)->real)(d)):bool``
   lemma) THEN
  REPEAT CONJ_TAC THENL
   [ALL_TAC,
    ONCE_REWRITE_TAC [METIS [] ``{k | k IN d /\ content k <> 0 /\ x IN k} =
                            {k | k IN d /\ (\k. content k <> 0 /\ x IN k) k}``] THEN
    MATCH_MP_TAC FINITE_RESTRICT THEN ASM_MESON_TAC[division_of],
    MATCH_MP_TAC LESS_EQ_TRANS THEN EXISTS_TAC ``CARD univ(:bool)`` THEN CONJ_TAC THENL
     [KNOW_TAC ``(IMAGE (\(d :real -> bool). (x :real) = (A :(real -> bool) -> real) d)
         {k | k IN (d :(real -> bool) -> bool) /\ content k <> (0 :real) /\
          x IN k}) SUBSET univ(:bool)`` THENL [REWRITE_TAC [SUBSET_UNIV], ALL_TAC] THEN
      MATCH_MP_TAC CARD_SUBSET THEN
      SIMP_TAC std_ss [FINITE_BOOL],
      SIMP_TAC std_ss [FINITE_BOOL, CARD_CART_UNIV, CARD_BOOL, LESS_EQ_REFL]]] THEN
  MAP_EVERY X_GEN_TAC [``k:real->bool``, ``l:real->bool``] THEN
  SIMP_TAC std_ss [GSPECIFICATION] THEN STRIP_TAC THEN
  UNDISCH_TAC ``d division_of s`` THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
  DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  DISCH_THEN(MP_TAC o SPECL [``k:real->bool``, ``l:real->bool``]) THEN
  ASM_REWRITE_TAC[GSYM INTERIOR_INTER] THEN
  MATCH_MP_TAC(TAUT `~q ==> (~p ==> q) ==> p`) THEN
  MAP_EVERY UNDISCH_TAC
   [``(x:real) IN k``, ``(x:real) IN l``,
    ``~(content(k:real->bool) = &0)``,
    ``~(content(l:real->bool) = &0)``] THEN
  SUBGOAL_THEN
   ``(k = interval[A k:real,B k]) /\ (l = interval[A l,B l])``
   (CONJUNCTS_THEN SUBST1_TAC)
  THENL [ASM_MESON_TAC[], REWRITE_TAC[INTER_INTERVAL]] THEN
  SIMP_TAC std_ss [CONTENT_EQ_0_INTERIOR, INTERIOR_CLOSED_INTERVAL] THEN
  SIMP_TAC std_ss [IN_INTERVAL, INTERVAL_NE_EMPTY] THEN
  UNDISCH_TAC ``(x = A k) <=> (x = (A:(real->bool)->real) l)`` THEN
  REWRITE_TAC[min_def, max_def] THEN
  Cases_on `A k <= A l` >> Cases_on `B k <= B l` >> rw []
  >- (`A l < x \/ (A l = x)` by PROVE_TAC [REAL_LE_LT]
      >- (MATCH_MP_TAC REAL_LTE_TRANS >> Q.EXISTS_TAC `x` >> art []) \\
      METIS_TAC []) \\
  `A k < x \/ (A k = x)` by PROVE_TAC [REAL_LE_LT]
  >- (MATCH_MP_TAC REAL_LTE_TRANS >> Q.EXISTS_TAC `x` >> art []) \\
  METIS_TAC []
QED

val lemma = prove (
  ``!f s. (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) /\
           FINITE s /\ CARD(IMAGE f s) <= n
           ==> CARD(s) <= n``,
    MESON_TAC[CARD_IMAGE_INJ]);

val TAGGED_PARTIAL_DIVISION_COMMON_POINT_BOUND = store_thm ("TAGGED_PARTIAL_DIVISION_COMMON_POINT_BOUND",
 ``!p s:real->bool y.
        p tagged_partial_division_of s
        ==> CARD {(x,k) | (x,k) IN p /\ y IN k /\ ~(content k = &0)}
            <= 2 EXP (1:num)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC ``SND`` lemma) THEN
  REPEAT CONJ_TAC THENL
   [SIMP_TAC std_ss [IMP_CONJ, FORALL_IN_GSPEC, RIGHT_FORALL_IMP_THM, PAIR_EQ] THEN
    MAP_EVERY X_GEN_TAC [``x1:real``, ``k1:real->bool``] THEN
    REPEAT DISCH_TAC THEN X_GEN_TAC ``x2:real`` THEN
    REPEAT DISCH_TAC THEN
    UNDISCH_TAC ``p tagged_partial_division_of s`` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o REWRITE_RULE [tagged_partial_division_of]) THEN
    DISCH_THEN(MP_TAC o SPECL
     [``x1:real``, ``k1:real->bool``, ``x2:real``, ``k1:real->bool``] o
     CONJUNCT2 o CONJUNCT2) THEN
    ASM_SIMP_TAC std_ss [PAIR_EQ] THEN
    MATCH_MP_TAC(TAUT `~q ==> (~p ==> q) ==> p`) THEN
    SIMP_TAC std_ss [INTER_ACI] THEN
    ASM_MESON_TAC[CONTENT_EQ_0_INTERIOR, tagged_partial_division_of],
    MATCH_MP_TAC FINITE_SUBSET THEN
    EXISTS_TAC ``p:real#(real->bool)->bool`` THEN CONJ_TAC THENL
     [ASM_MESON_TAC[tagged_partial_division_of],
      SIMP_TAC std_ss [LAMBDA_PAIR] THEN SET_TAC[]],
    FIRST_ASSUM(MP_TAC o MATCH_MP PARTIAL_DIVISION_OF_TAGGED_DIVISION) THEN
    DISCH_THEN(MP_TAC o SPEC ``y:real`` o
      MATCH_MP DIVISION_COMMON_POINT_BOUND) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LESS_EQ_TRANS) THEN
    KNOW_TAC ``(IMAGE (SND :real # (real -> bool) -> real -> bool)
         {(x,k) | (x,k) IN (p :real # (real -> bool) -> bool) /\ (y :real) IN k /\
          content k <> (0 :real)}) SUBSET
             {k | k IN IMAGE (SND :real # (real -> bool) -> real -> bool) p /\
       content k <> (0 :real) /\ y IN k}`` THENL
    [SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_IMAGE, FORALL_IN_GSPEC] THEN
     SIMP_TAC std_ss [GSPECIFICATION, IN_IMAGE, EXISTS_PROD] THEN MESON_TAC[],
     ALL_TAC] THEN
    MATCH_MP_TAC CARD_SUBSET THEN
    ONCE_REWRITE_TAC [METIS []
        ``{k | k IN IMAGE SND p /\ content k <> 0 /\ y IN k} =
      {k | k IN IMAGE SND p /\ (\k. content k <> 0 /\ y IN k) k}``] THEN
      MATCH_MP_TAC FINITE_RESTRICT THEN MATCH_MP_TAC IMAGE_FINITE THEN
      ASM_MESON_TAC[tagged_partial_division_of]]);

val TAGGED_PARTIAL_DIVISION_COMMON_TAGS = store_thm ("TAGGED_PARTIAL_DIVISION_COMMON_TAGS",
 ``!p s:real->bool x.
        p tagged_partial_division_of s
        ==> CARD {(x,k) | k | (x,k) IN p /\ ~(content k = &0)}
            <= 2 EXP (1:num)``,
  REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC ``x:real`` o
   MATCH_MP TAGGED_PARTIAL_DIVISION_COMMON_POINT_BOUND) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LESS_EQ_TRANS) THEN
  KNOW_TAC ``{((x :real),k) |
       k | (x,k) IN (p :real # (real -> bool) -> bool) /\
       content k <> (0 :real)} SUBSET
       {(x',k) | (x',k) IN p /\ x IN k /\ content k <> (0 :real)}`` THENL
  [SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_GSPEC, IN_ELIM_PAIR_THM] THEN
    ASM_MESON_TAC[tagged_partial_division_of], ALL_TAC] THEN
  MATCH_MP_TAC CARD_SUBSET THEN
    MATCH_MP_TAC FINITE_SUBSET THEN
    EXISTS_TAC ``p:real#(real->bool)->bool`` THEN CONJ_TAC THENL
     [ASM_MESON_TAC[tagged_partial_division_of],
      SIMP_TAC std_ss [LAMBDA_PAIR] THEN SET_TAC[]]);

(* ------------------------------------------------------------------------- *)
(* Integrating characteristic function of an interval.                       *)
(* ------------------------------------------------------------------------- *)

val HAS_INTEGRAL_RESTRICT_OPEN_SUBINTERVAL = store_thm ("HAS_INTEGRAL_RESTRICT_OPEN_SUBINTERVAL",
 ``!f:real->real a b c d i.
        (f has_integral i) (interval[c,d]) /\
        interval[c,d] SUBSET interval[a,b]
        ==> ((\x. if x IN interval(c,d) then f x else 0) has_integral i)
             (interval[a,b])``,
  REPEAT GEN_TAC THEN ASM_CASES_TAC ``interval[c:real,d] = {}`` THENL
   [FIRST_ASSUM(MP_TAC o AP_TERM
     ``interior:(real->bool)->(real->bool)``) THEN
    SIMP_TAC std_ss [INTERIOR_CLOSED_INTERVAL, INTERIOR_EMPTY] THEN
    ASM_SIMP_TAC std_ss [NOT_IN_EMPTY, HAS_INTEGRAL_0_EQ, HAS_INTEGRAL_EMPTY_EQ],
    ALL_TAC] THEN
  ABBREV_TAC ``g:real->real =
                 \x. if x IN interval(c,d) then f x else 0`` THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  UNDISCH_TAC ``interval [(c,d)] <> {}`` THEN
  REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN
  DISCH_THEN(MP_TAC o MATCH_MP PARTIAL_DIVISION_EXTEND_1) THEN
  DISCH_THEN(X_CHOOSE_THEN ``p:(real->bool)->bool`` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL
   [``lifted((+):real->real->real)``,
    ``p:(real->bool)->bool``,
    ``a:real``, ``b:real``,
    ``\i. if (g:real->real) integrable_on i
         then SOME (integral i g) else NONE``]
   OPERATIVE_DIVISION) THEN
  ASM_SIMP_TAC std_ss [OPERATIVE_INTEGRAL, MONOIDAL_LIFTED, MONOIDAL_REAL_ADD] THEN
  SUBGOAL_THEN
   ``iterate (lifted (+)) p
     (\i. if (g:real->real) integrable_on i
          then SOME (integral i g) else NONE) =
    SOME i``
  SUBST1_TAC THENL
   [ALL_TAC,
    COND_CASES_TAC THEN
    SIMP_TAC std_ss [FORALL_OPTION, lifted, NOT_NONE_SOME, option_CLAUSES] THEN
    ASM_MESON_TAC[INTEGRABLE_INTEGRAL]] THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
  FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE
   ``x IN s ==> (s = x INSERT (s DELETE x))``)) THEN
  ASM_SIMP_TAC std_ss [ITERATE_CLAUSES, MONOIDAL_LIFTED, MONOIDAL_REAL_ADD,
               FINITE_DELETE, IN_DELETE] THEN
  SUBGOAL_THEN ``(g:real->real) integrable_on interval[c,d]``
  ASSUME_TAC THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP HAS_INTEGRAL_INTEGRABLE) THEN
    MATCH_MP_TAC INTEGRABLE_SPIKE_INTERIOR THEN
    EXPAND_TAC "g" THEN SIMP_TAC std_ss [],
    ALL_TAC] THEN
  ASM_REWRITE_TAC[] THEN
  SUBGOAL_THEN
   ``iterate (lifted (+)) (p DELETE interval[c,d])
      (\i. if (g:real->real) integrable_on i
           then SOME (integral i g) else NONE) = SOME(0)``
  SUBST1_TAC THENL
   [ALL_TAC,
    REWRITE_TAC[lifted, REAL_ADD_RID] THEN AP_TERM_TAC THEN
    MATCH_MP_TAC INTEGRAL_UNIQUE THEN
    MATCH_MP_TAC HAS_INTEGRAL_SPIKE_INTERIOR THEN
    EXISTS_TAC ``f:real->real`` THEN
    EXPAND_TAC "g" THEN ASM_SIMP_TAC std_ss []] THEN
  SIMP_TAC std_ss [GSYM NEUTRAL_REAL_ADD, GSYM NEUTRAL_LIFTED,
           MONOIDAL_REAL_ADD] THEN
  MATCH_MP_TAC(MATCH_MP ITERATE_EQ_NEUTRAL
        (MATCH_MP MONOIDAL_LIFTED(SPEC_ALL MONOIDAL_REAL_ADD))) THEN
  SIMP_TAC std_ss [NEUTRAL_LIFTED, NEUTRAL_REAL_ADD, MONOIDAL_REAL_ADD] THEN
  X_GEN_TAC ``k:real->bool`` THEN REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN
  SUBGOAL_THEN ``((g:real->real) has_integral (0)) k``
   (fn th => METIS_TAC[th, integrable_on, INTEGRAL_UNIQUE]) THEN
  SUBGOAL_THEN ``?u v:real. k = interval[u,v]`` MP_TAC THENL
   [ASM_MESON_TAC[division_of], ALL_TAC] THEN
  DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THEN
  MATCH_MP_TAC HAS_INTEGRAL_SPIKE_INTERIOR THEN
  EXISTS_TAC ``(\x. 0):real->real`` THEN
  REWRITE_TAC[HAS_INTEGRAL_0] THEN X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
  UNDISCH_TAC ``p division_of interval [(a,b)]`` THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
  STRIP_TAC THEN UNDISCH_TAC `` !(k1 :real -> bool) (k2 :real -> bool).
             k1 IN (p :(real -> bool) -> bool) /\ k2 IN p /\ k1 <> k2 ==>
             (interior k1 INTER interior k2 = ({} :real -> bool))`` THEN
  DISCH_THEN(MP_TAC o SPECL
   [``interval[c:real,d]``, ``interval[u:real,v]``]) THEN
  ASM_REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN
  EXPAND_TAC "g" THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_SET_TAC[]);

val HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL = store_thm ("HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL",
 ``!f:real->real a b c d i.
        (f has_integral i) (interval[c,d]) /\
        interval[c,d] SUBSET interval[a,b]
        ==> ((\x. if x IN interval[c,d] then f x else 0) has_integral i)
             (interval[a,b])``,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_RESTRICT_OPEN_SUBINTERVAL) THEN
  MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`]
    HAS_INTEGRAL_SPIKE) THEN
  EXISTS_TAC ``interval[c:real,d] DIFF interval(c,d)`` THEN
  REWRITE_TAC[NEGLIGIBLE_FRONTIER_INTERVAL] THEN REWRITE_TAC[IN_DIFF] THEN
  MP_TAC(ISPECL [``c:real``, ``d:real``] INTERVAL_OPEN_SUBSET_CLOSED) THEN
  SET_TAC[]);

val HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVALS_EQ = store_thm ("HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVALS_EQ",
 ``!f:real->real a b c d i.
        interval[c,d] SUBSET interval[a,b]
        ==> (((\x. if x IN interval[c,d] then f x else 0) has_integral i)
              (interval[a,b]) <=>
             (f has_integral i) (interval[c,d]))``,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC ``interval[c:real,d] = {}`` THENL
   [ASM_SIMP_TAC std_ss [NOT_IN_EMPTY, HAS_INTEGRAL_0_EQ, HAS_INTEGRAL_EMPTY_EQ],
    ALL_TAC] THEN
  EQ_TAC THEN DISCH_TAC THEN
  ASM_SIMP_TAC std_ss [HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL] THEN
  SUBGOAL_THEN ``(f:real->real) integrable_on interval[c,d]`` MP_TAC THENL
   [MATCH_MP_TAC INTEGRABLE_EQ THEN
    EXISTS_TAC ``\x. if x IN interval[c:real,d]
                    then f x:real else 0`` THEN
    SIMP_TAC std_ss [] THEN MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN
    ASM_MESON_TAC[integrable_on],
    ALL_TAC] THEN
  DISCH_THEN(fn th => ASSUME_TAC th THEN MP_TAC th) THEN
  DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN
  MP_TAC(ASSUME ``interval[c:real,d] SUBSET interval[a,b]``) THEN
  REWRITE_TAC[AND_IMP_INTRO] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
  DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL) THEN
  ASM_MESON_TAC[HAS_INTEGRAL_UNIQUE, INTEGRABLE_INTEGRAL]);

(* ------------------------------------------------------------------------- *)
(* Hence we can apply the limit process uniformly to all integrals.          *)
(* ------------------------------------------------------------------------- *)

val HAS_INTEGRAL = store_thm ("HAS_INTEGRAL",
 ``!f:real->real i s.
     (f has_integral i) s <=>
        !e. &0 < e
            ==> ?B. &0 < B /\
                    !a b. ball(0,B) SUBSET interval[a,b]
                          ==> ?z. ((\x. if x IN s then f(x) else 0)
                                   has_integral z) (interval[a,b]) /\
                                  abs(z - i) < e``,
  REPEAT GEN_TAC THEN GEN_REWR_TAC LAND_CONV [has_integral_alt] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
  POP_ASSUM(X_CHOOSE_THEN ``a:real`` (X_CHOOSE_THEN ``b:real``
   SUBST_ALL_TAC)) THEN
  MP_TAC(ISPECL [``a:real``, ``b:real``] (CONJUNCT1 BOUNDED_INTERVAL)) THEN
  REWRITE_TAC[BOUNDED_POS] THEN
  DISCH_THEN(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC) THEN EQ_TAC THENL
   [DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
    EXISTS_TAC ``B + &1:real`` THEN ASM_SIMP_TAC std_ss [REAL_LT_ADD, REAL_LT_01] THEN
    MAP_EVERY X_GEN_TAC [``c:real``, ``d:real``] THEN
    SIMP_TAC std_ss [SUBSET_DEF, IN_BALL, DIST_0] THEN
    DISCH_TAC THEN EXISTS_TAC ``i:real`` THEN
    ASM_REWRITE_TAC[REAL_SUB_REFL, ABS_0] THEN
    MATCH_MP_TAC HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL THEN
    ASM_MESON_TAC[SUBSET_DEF, REAL_ARITH ``n <= B ==> n < B + &1:real``],
    ALL_TAC] THEN
  DISCH_TAC THEN
  SUBGOAL_THEN ``?y. ((f:real->real) has_integral y) (interval[a,b])``
  MP_TAC THENL
   [SUBGOAL_THEN
     ``?c d. interval[a,b] SUBSET interval[c,d] /\
            (\x. if x IN interval[a,b] then (f:real->real) x
                 else 0) integrable_on interval[c,d]``
    STRIP_ASSUME_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o C MATCH_MP REAL_LT_01) THEN
      DISCH_THEN(X_CHOOSE_THEN ``C:real`` STRIP_ASSUME_TAC) THEN
      ABBREV_TAC ``c:real = @f. f = -(max B C)`` THEN
      ABBREV_TAC ``d:real = @f. f = max B C`` THEN
      MAP_EVERY EXISTS_TAC [``c:real``, ``d:real``] THEN CONJ_TAC THENL
       [REWRITE_TAC[SUBSET_DEF] THEN X_GEN_TAC ``x:real`` THEN
        DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN
        MAP_EVERY EXPAND_TAC ["c", "d"] THEN
        SIMP_TAC std_ss [GSYM ABS_BOUNDS] THEN
        MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``abs(x:real)`` THEN
        ASM_SIMP_TAC std_ss [REAL_LE_REFL] THEN
        MATCH_MP_TAC(METIS [REAL_LE_MAX] ``x <= B ==> (x:real) <= max B C``) THEN
        ASM_SIMP_TAC std_ss [],
        ALL_TAC] THEN
      FIRST_X_ASSUM(MP_TAC o SPECL [``c:real``, ``d:real``]) THEN
      KNOW_TAC ``ball (0,C) SUBSET interval [(c,d)]`` THENL
       [REWRITE_TAC[SUBSET_DEF, IN_BALL, DIST_0] THEN
        X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN
        MAP_EVERY EXPAND_TAC ["c", "d"] THEN SIMP_TAC std_ss [GSYM ABS_BOUNDS] THEN
        MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``abs(x:real)`` THEN
        ASM_SIMP_TAC std_ss [REAL_LE_REFL] THEN
        MATCH_MP_TAC(METIS [REAL_LE_MAX, REAL_LT_IMP_LE]
         ``x < C ==> x:real <= max B C``) THEN
        ASM_SIMP_TAC std_ss [],
        ALL_TAC] THEN
      MESON_TAC[integrable_on],
      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [integrable_on]) THEN
      ASM_SIMP_TAC std_ss [HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVALS_EQ]],
    ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_TAC ``y:real``) THEN
  SUBGOAL_THEN ``i:real = y`` ASSUME_TAC THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC(REAL_ARITH ``~(&0 < abs(y - i)) ==> (i = y:real)``) THEN
  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``abs(y - i:real)``) THEN
  ASM_SIMP_TAC std_ss [NOT_EXISTS_THM] THEN X_GEN_TAC ``C:real`` THEN
  CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN POP_ASSUM MP_TAC THEN
  SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP] THEN
  ABBREV_TAC ``c:real = @f. f = -(max B C)`` THEN
  ABBREV_TAC ``d:real = @f. f = max B C`` THEN
  MAP_EVERY EXISTS_TAC [``c:real``, ``d:real``] THEN CONJ_TAC THENL
   [REWRITE_TAC[SUBSET_DEF, IN_BALL, DIST_0] THEN
    X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN
    MAP_EVERY EXPAND_TAC ["c", "d"] THEN
    SIMP_TAC std_ss [GSYM ABS_BOUNDS] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``abs(x:real)`` THEN
    ASM_SIMP_TAC std_ss [REAL_LE_REFL] THEN
    MATCH_MP_TAC(METIS [REAL_LE_MAX, REAL_LT_IMP_LE]
     ``x < C ==> x:real <= max B C``) THEN
    ASM_SIMP_TAC std_ss [],
    ALL_TAC] THEN
  SUBGOAL_THEN ``interval[a:real,b] SUBSET interval[c,d]`` ASSUME_TAC THENL
   [REWRITE_TAC[SUBSET_DEF] THEN X_GEN_TAC ``x:real`` THEN
    DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN
    MAP_EVERY EXPAND_TAC ["c", "d"] THEN SIMP_TAC std_ss [GSYM ABS_BOUNDS] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``abs(x:real)`` THEN
    ASM_SIMP_TAC std_ss [REAL_LE_REFL] THEN
    MATCH_MP_TAC(METIS [REAL_LE_MAX] ``x <= B ==> x:real <= max B C``) THEN
    ASM_SIMP_TAC std_ss [],
    ALL_TAC] THEN
  ASM_SIMP_TAC std_ss [HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVALS_EQ] THEN
  ASM_MESON_TAC[REAL_LT_REFL, HAS_INTEGRAL_UNIQUE]);

(* ------------------------------------------------------------------------- *)
(* Hence a general restriction property.                 5952                *)
(* ------------------------------------------------------------------------- *)

val HAS_INTEGRAL_RESTRICT = store_thm ("HAS_INTEGRAL_RESTRICT",
 ``!f:real->real s t i.
        s SUBSET t
        ==> (((\x. if x IN s then f x else 0) has_integral i) t <=>
             (f has_integral i) s)``,
  REWRITE_TAC[SUBSET_DEF] THEN REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN SIMP_TAC std_ss [] THEN
  ONCE_REWRITE_TAC[METIS [] ``(if p then if q then x else y else y) =
                             (if q then if p then x else y else y)``] THEN
  ASM_SIMP_TAC std_ss []);

val INTEGRAL_RESTRICT = store_thm ("INTEGRAL_RESTRICT",
 ``!f:real->real s t.
        s SUBSET t
        ==> (integral t (\x. if x IN s then f x else 0) =
             integral s f)``,
  SIMP_TAC std_ss [integral, HAS_INTEGRAL_RESTRICT]);

val INTEGRABLE_RESTRICT = store_thm ("INTEGRABLE_RESTRICT",
 ``!f:real->real s t.
        s SUBSET t
        ==> (((\x. if x IN s then f x else 0) integrable_on t <=>
              f integrable_on s))``,
  SIMP_TAC std_ss [integrable_on, HAS_INTEGRAL_RESTRICT]);

val HAS_INTEGRAL_RESTRICT_UNIV = store_thm ("HAS_INTEGRAL_RESTRICT_UNIV",
 ``!f:real->real s i.
        ((\x. if x IN s then f x else 0) has_integral i) univ(:real) <=>
         (f has_integral i) s``,
  SIMP_TAC std_ss [HAS_INTEGRAL_RESTRICT, SUBSET_UNIV]);

val INTEGRAL_RESTRICT_UNIV = store_thm ("INTEGRAL_RESTRICT_UNIV",
 ``!f:real->real s.
        integral univ(:real) (\x. if x IN s then f x else 0) =
        integral s f``,
  REWRITE_TAC[integral, HAS_INTEGRAL_RESTRICT_UNIV]);

val INTEGRABLE_RESTRICT_UNIV = store_thm ("INTEGRABLE_RESTRICT_UNIV",
 ``!f s. (\x. if x IN s then f x else 0) integrable_on univ(:real) <=>
         f integrable_on s``,
  REWRITE_TAC[integrable_on, HAS_INTEGRAL_RESTRICT_UNIV]);

val HAS_INTEGRAL_RESTRICT_INTER = store_thm ("HAS_INTEGRAL_RESTRICT_INTER",
 ``!f:real->real s t.
        ((\x. if x IN s then f x else 0) has_integral i) t <=>
        (f has_integral i) (s INTER t)``,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN
  REWRITE_TAC[IN_INTER] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
  REWRITE_TAC[FUN_EQ_THM] THEN METIS_TAC[]);

val INTEGRAL_RESTRICT_INTER = store_thm ("INTEGRAL_RESTRICT_INTER",
 ``!f:real->real s t.
        integral t (\x. if x IN s then f x else 0) =
        integral (s INTER t) f``,
  REWRITE_TAC[integral, HAS_INTEGRAL_RESTRICT_INTER]);

val INTEGRABLE_RESTRICT_INTER = store_thm ("INTEGRABLE_RESTRICT_INTER",
 ``!f:real->real s t.
        (\x. if x IN s then f x else 0) integrable_on t <=>
        f integrable_on (s INTER t)``,
  REWRITE_TAC[integrable_on, HAS_INTEGRAL_RESTRICT_INTER]);

val HAS_INTEGRAL_ON_SUPERSET = store_thm ("HAS_INTEGRAL_ON_SUPERSET",
 ``!f s t i.
        (!x. ~(x IN s) ==> (f x = 0)) /\ s SUBSET t /\ (f has_integral i) s
        ==> (f has_integral i) t``,
  REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET_DEF] THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN
  MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN AP_THM_TAC THEN
  AP_TERM_TAC THEN ABS_TAC THEN METIS_TAC[]);

val INTEGRABLE_ON_SUPERSET = store_thm ("INTEGRABLE_ON_SUPERSET",
 ``!f s t.
        (!x. ~(x IN s) ==> (f x = 0)) /\ s SUBSET t /\ f integrable_on s
        ==> f integrable_on t``,
  REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_ON_SUPERSET]);

val NEGLIGIBLE_ON_INTERVALS = store_thm ("NEGLIGIBLE_ON_INTERVALS",
 ``!s. negligible s <=> !a b:real. negligible(s INTER interval[a,b])``,
  GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
   [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC ``s:real->bool`` THEN
    ASM_REWRITE_TAC[] THEN SET_TAC[],
    ALL_TAC] THEN
  REWRITE_TAC[negligible] THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN
  FIRST_ASSUM(ASSUME_TAC o SPECL [``a:real``, ``b:real``]) THEN
  MATCH_MP_TAC HAS_INTEGRAL_NEGLIGIBLE THEN
  EXISTS_TAC ``s INTER interval[a:real,b]`` THEN
  ASM_REWRITE_TAC[] THEN SIMP_TAC std_ss [indicator, IN_DIFF, IN_INTER] THEN
  METIS_TAC[]);

val NEGLIGIBLE_BOUNDED_SUBSETS = store_thm ("NEGLIGIBLE_BOUNDED_SUBSETS",
 ``!s:real->bool.
    negligible s <=> !t. bounded t /\ t SUBSET s ==> negligible t``,
  METIS_TAC[NEGLIGIBLE_ON_INTERVALS, INTER_SUBSET, BOUNDED_SUBSET,
            BOUNDED_INTERVAL, NEGLIGIBLE_SUBSET]);

val NEGLIGIBLE_ON_COUNTABLE_INTERVALS = store_thm ("NEGLIGIBLE_ON_COUNTABLE_INTERVALS",
 ``!s:real->bool.
        negligible s <=>
        !n. negligible (s INTER interval[-n, n])``,
  GEN_TAC THEN GEN_REWR_TAC LAND_CONV [NEGLIGIBLE_ON_INTERVALS] THEN
  EQ_TAC THEN SIMP_TAC std_ss [] THEN REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   ``!a b:real. ?n. s INTER interval[a,b] =
                     ((s INTER interval[-n,n]) INTER interval[a,b])``
   (fn th => METIS_TAC[th, NEGLIGIBLE_ON_INTERVALS]) THEN
  REPEAT GEN_TAC THEN
  MP_TAC(ISPECL [``interval[a:real,b]``, ``0:real``]
        BOUNDED_SUBSET_CBALL) THEN
  REWRITE_TAC[BOUNDED_INTERVAL] THEN
  DISCH_THEN(X_CHOOSE_THEN ``r:real`` STRIP_ASSUME_TAC) THEN
  MP_TAC(SPEC ``r:real`` SIMP_REAL_ARCH) THEN
  STRIP_TAC THEN EXISTS_TAC ``&n:real`` THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
   ``i SUBSET b ==> b SUBSET n ==> (s INTER i = (s INTER n) INTER i)``)) THEN
  REWRITE_TAC[SUBSET_DEF, IN_CBALL_0, IN_INTERVAL, GSYM ABS_BOUNDS]  THEN
  METIS_TAC[REAL_LE_TRANS]);

val HAS_INTEGRAL_SPIKE_SET_EQ = store_thm ("HAS_INTEGRAL_SPIKE_SET_EQ",
 ``!f:real->real s t y.
        negligible((s DIFF t) UNION (t DIFF s))
        ==> ((f has_integral y) s <=> (f has_integral y) t)``,
  REPEAT STRIP_TAC THEN  ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN
  MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ THEN
  EXISTS_TAC ``(s DIFF t) UNION (t DIFF s:real->bool)`` THEN
  ASM_SIMP_TAC std_ss [] THEN SET_TAC[]);

val HAS_INTEGRAL_SPIKE_SET = store_thm ("HAS_INTEGRAL_SPIKE_SET",
 ``!f:real->real s t y.
        negligible((s DIFF t) UNION (t DIFF s)) /\
        (f has_integral y) s
        ==> (f has_integral y) t``,
  MESON_TAC[HAS_INTEGRAL_SPIKE_SET_EQ]);

val INTEGRABLE_SPIKE_SET = store_thm ("INTEGRABLE_SPIKE_SET",
 ``!f:real->real s t.
        negligible(s DIFF t UNION (t DIFF s))
        ==> f integrable_on s ==> f integrable_on t``,
  REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_SPIKE_SET_EQ]);

val INTEGRABLE_SPIKE_SET_EQ = store_thm ("INTEGRABLE_SPIKE_SET_EQ",
 ``!f:real->real s t.
        negligible(s DIFF t UNION (t DIFF s))
        ==> (f integrable_on s <=> f integrable_on t)``,
  MESON_TAC[INTEGRABLE_SPIKE_SET, UNION_COMM]);

val INTEGRAL_SPIKE_SET = store_thm ("INTEGRAL_SPIKE_SET",
 ``!f:real->real s t.
        negligible(s DIFF t UNION (t DIFF s))
        ==> (integral s f = integral t f)``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[integral] THEN
  AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_SET_EQ THEN
  ASM_MESON_TAC[]);

val HAS_INTEGRAL_INTERIOR = store_thm ("HAS_INTEGRAL_INTERIOR",
 ``!f:real->real y s.
        negligible(frontier s)
        ==> ((f has_integral y) (interior s) <=> (f has_integral y) s)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_SET_EQ THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
    NEGLIGIBLE_SUBSET)) THEN
  REWRITE_TAC[frontier] THEN
  MP_TAC(ISPEC ``s:real->bool`` INTERIOR_SUBSET) THEN
  MP_TAC(ISPEC ``s:real->bool`` CLOSURE_SUBSET) THEN
  SET_TAC[]);

val HAS_INTEGRAL_CLOSURE = store_thm ("HAS_INTEGRAL_CLOSURE",
 ``!f:real->real y s.
        negligible(frontier s)
        ==> ((f has_integral y) (closure s) <=> (f has_integral y) s)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_SET_EQ THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
    NEGLIGIBLE_SUBSET)) THEN
  REWRITE_TAC[frontier] THEN
  MP_TAC(ISPEC ``s:real->bool`` INTERIOR_SUBSET) THEN
  MP_TAC(ISPEC ``s:real->bool`` CLOSURE_SUBSET) THEN
  SET_TAC[]);

val INTEGRABLE_CASES = store_thm ("INTEGRABLE_CASES",
 ``!P f g:real->real s.
        f integrable_on {x | x IN s /\ P x} /\
        g integrable_on {x | x IN s /\ ~P x}
        ==> (\x. if P x then f x else g x) integrable_on s``,
  REPEAT GEN_TAC THEN
  ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN
  DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_ADD) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] INTEGRABLE_EQ) THEN
  SIMP_TAC std_ss [IN_UNIV, GSPECIFICATION] THEN
  METIS_TAC[REAL_ADD_LID, REAL_ADD_RID]);

(* ------------------------------------------------------------------------- *)
(* More lemmas that are useful later.                                        *)
(* ------------------------------------------------------------------------- *)

val HAS_INTEGRAL_DROP_POS_AE = store_thm ("HAS_INTEGRAL_DROP_POS_AE",
 ``!f:real->real s t i.
        (f has_integral i) s /\
        negligible t /\ (!x. x IN s DIFF t ==> &0 <= f x)
        ==> &0 <= i``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_DROP_POS THEN
  EXISTS_TAC ``f:real->real`` THEN EXISTS_TAC ``s DIFF t:real->bool`` THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_SET THEN
  EXISTS_TAC ``s:real->bool`` THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        NEGLIGIBLE_SUBSET)) THEN
  SET_TAC[]);

val INTEGRAL_DROP_POS_AE = store_thm ("INTEGRAL_DROP_POS_AE",
 ``!f:real->real s t.
        f integrable_on s /\
        negligible t /\ (!x. x IN s DIFF t ==> &0 <=(f x))
        ==> &0 <= (integral s f)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_DROP_POS_AE THEN
  ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);

val HAS_INTEGRAL_SUBSET_COMPONENT_LE = store_thm ("HAS_INTEGRAL_SUBSET_COMPONENT_LE",
 ``!f:real->real s t i j.
        s SUBSET t /\ (f has_integral i) s /\ (f has_integral j) t /\
        (!x. x IN t ==> &0 <= f(x))
        ==> i <= j``,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN
  STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LE THEN
  MAP_EVERY EXISTS_TAC
   [``(\x. if x IN s then f x else 0):real->real``,
    ``(\x. if x IN t then f x else 0):real->real``,
    ``univ(:real)``] THEN
  ASM_SIMP_TAC std_ss [] THEN
  REPEAT STRIP_TAC THEN
  REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]) THEN
  ASM_SET_TAC[]);

val INTEGRAL_SUBSET_COMPONENT_LE = store_thm ("INTEGRAL_SUBSET_COMPONENT_LE",
 ``!f:real->real s t.
        s SUBSET t /\ f integrable_on s /\ f integrable_on t /\
        (!x. x IN t ==> &0 <= f(x))
        ==> (integral s f) <= (integral t f)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SUBSET_COMPONENT_LE THEN
  ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);

val HAS_INTEGRAL_SUBSET_DROP_LE = store_thm ("HAS_INTEGRAL_SUBSET_DROP_LE",
 ``!f:real->real s t i j.
        s SUBSET t /\ (f has_integral i) s /\ (f has_integral j) t /\
        (!x. x IN t ==> &0 <= (f x))
        ==> i <= j``,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC HAS_INTEGRAL_SUBSET_COMPONENT_LE THEN
  REWRITE_TAC[LESS_EQ_REFL] THEN ASM_MESON_TAC[]);

val INTEGRAL_SUBSET_DROP_LE = store_thm ("INTEGRAL_SUBSET_DROP_LE",
 ``!f:real->real s t.
        s SUBSET t /\ f integrable_on s /\ f integrable_on t /\
        (!x. x IN t ==> &0 <= (f(x)))
        ==> (integral s f) <= (integral t f)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SUBSET_DROP_LE THEN
  ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);

val HAS_INTEGRAL_ALT = store_thm ("HAS_INTEGRAL_ALT",
 ``!f:real->real s i.
        (f has_integral i) s <=>
            (!a b. (\x. if x IN s then f x else 0)
                   integrable_on interval[a,b]) /\
            (!e. &0 < e
                 ==> ?B. &0 < B /\
                         !a b. ball (0,B) SUBSET interval[a,b]
                               ==> abs(integral(interval[a,b])
                                          (\x. if x IN s then f x else 0) -
                                        i) < e)``,
  REPEAT GEN_TAC THEN GEN_REWR_TAC LAND_CONV [HAS_INTEGRAL] THEN
  SPEC_TAC(``\x. if x IN s then (f:real->real) x else 0``,
           ``f:real->real``) THEN
  GEN_TAC THEN EQ_TAC THENL
   [ALL_TAC, MESON_TAC[INTEGRAL_UNIQUE, integrable_on]] THEN
  DISCH_TAC THEN CONJ_TAC THENL
   [ALL_TAC, ASM_MESON_TAC[INTEGRAL_UNIQUE]] THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN
  POP_ASSUM(MP_TAC o C MATCH_MP REAL_LT_01) THEN
  DISCH_THEN(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN
  EXISTS_TAC ``(@f. f = min ((a:real)) (-B)):real`` THEN
  EXISTS_TAC ``(@f. f = max ((b:real)) B):real`` THEN CONJ_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o SPECL
     [``(@f. f = min ((a:real)) (-B)):real``,
      ``(@f. f = max ((b:real)) B):real``]) THEN
    KNOW_TAC ``ball ((0 :real),(B :real)) SUBSET
     interval
       [((@(f :real). f = min (a :real) (-B)),
         @(f :real). f = max (b :real) B)]`` THENL
    [ALL_TAC, MESON_TAC[integrable_on]], ALL_TAC] THEN
    SIMP_TAC std_ss [SUBSET_DEF, IN_INTERVAL, IN_BALL,
             REAL_MIN_LE, REAL_LE_MAX] THEN REWRITE_TAC [dist] THEN REAL_ARITH_TAC);

val INTEGRABLE_ALT = store_thm ("INTEGRABLE_ALT",
 ``!f:real->real s.
        f integrable_on s <=>
          (!a b. (\x. if x IN s then f x else 0) integrable_on
                 interval[a,b]) /\
          (!e. &0 < e
               ==> ?B. &0 < B /\
                       !a b c d.
                          ball(0,B) SUBSET interval[a,b] /\
                          ball(0,B) SUBSET interval[c,d]
                          ==> abs(integral (interval[a,b])
                                    (\x. if x IN s then f x else 0) -
                                   integral (interval[c,d])
                                    (\x. if x IN s then f x else 0)) < e)``,
  REPEAT GEN_TAC THEN
  GEN_REWR_TAC LAND_CONV [integrable_on] THEN
  ONCE_REWRITE_TAC[HAS_INTEGRAL_ALT] THEN
  SIMP_TAC std_ss [RIGHT_EXISTS_AND_THM] THEN
  MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN
  DISCH_TAC THEN EQ_TAC THENL
   [DISCH_THEN(X_CHOOSE_THEN ``y:real`` STRIP_ASSUME_TAC) THEN
    X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
    DISCH_THEN (X_CHOOSE_TAC ``B:real``) THEN EXISTS_TAC ``B:real`` THEN
    METIS_TAC[REAL_ARITH ``abs(a - y) < e / (&2:real) /\ abs(b - y) < e / &2
                          ==> abs(a - b) < e / &2 + e / &2``, REAL_HALF],
    ALL_TAC] THEN
  DISCH_TAC THEN
  SUBGOAL_THEN
   ``cauchy (\n. integral (interval[(@f. f = -(&n)),(@f. f = &n)])
                         (\x. if x IN s then (f:real->real) x else 0))``
  MP_TAC THENL
   [REWRITE_TAC[cauchy] THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``e:real``) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC) THEN
    MP_TAC(SPEC ``B:real`` SIMP_REAL_ARCH) THEN
    DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
    REPEAT STRIP_TAC THEN REWRITE_TAC[dist] THEN BETA_TAC THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    REWRITE_TAC[SUBSET_DEF, IN_BALL, DIST_0] THEN
    CONJ_TAC,
    REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN
    DISCH_THEN (X_CHOOSE_TAC ``i:real``) THEN EXISTS_TAC ``i:real`` THEN
    POP_ASSUM MP_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_TAC THEN
    X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
    UNDISCH_TAC ``!(e :real). (0 :real) < e ==>
            ?(N :num). !(n :num).  N <= n ==>
                (dist ((\(n :num).
                       integral (interval
                            [((@(f :real). f = -((&n) :real)),
                              @(f :real). f = ((&n) :real))])
                         (\(x :real).
                            if x IN (s :real -> bool) then
                              (f :real -> real) x
                            else (0 :real))) n,(i :real)) :real) < e`` THEN
    DISCH_TAC THEN
    FIRST_X_ASSUM (MP_TAC o SPEC ``e / &2:real``) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
    DISCH_THEN(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC) THEN
    DISCH_THEN(X_CHOOSE_THEN ``N:num`` ASSUME_TAC) THEN
    MP_TAC(SPEC ``max (&N) B:real`` SIMP_REAL_ARCH) THEN
    REWRITE_TAC[REAL_MAX_LE, REAL_OF_NUM_LE] THEN
    DISCH_THEN(X_CHOOSE_THEN ``n:num`` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC ``&n:real`` THEN CONJ_TAC THENL
     [METIS_TAC [REAL_LTE_TRANS], ALL_TAC] THEN
    MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``n:num``) THEN ASM_SIMP_TAC std_ss [] THEN
    GEN_REWR_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_HALF] THEN
        REWRITE_TAC [dist] THEN
    MATCH_MP_TAC(REAL_ARITH
     ``abs(i1 - i2) < e / &2 ==> abs(i1 - i) < e / &2 ==>
       abs(i2 - i) < e / &2 + e / &2:real``) THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN
    MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC ``ball(0:real,&n)`` THEN
    ASM_SIMP_TAC std_ss [SUBSET_BALL] THEN
    REWRITE_TAC[SUBSET_DEF, IN_BALL, DIST_0]] THEN
  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
  SIMP_TAC std_ss [IN_INTERVAL] THEN REPEAT GEN_TAC THEN
  REWRITE_TAC[GSYM ABS_BOUNDS] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC ``abs(x:real)`` THEN ASM_SIMP_TAC std_ss [REAL_LE_REFL] THEN
  REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM REAL_OF_NUM_GE, real_ge] THEN
  METIS_TAC [REAL_LE_TRANS, REAL_LE_LT]);

val INTEGRABLE_ALT_SUBSET = store_thm ("INTEGRABLE_ALT_SUBSET",
 ``!f:real->real s.
        f integrable_on s <=>
          (!a b. (\x. if x IN s then f x else 0) integrable_on
                 interval[a,b]) /\
          (!e. &0 < e
               ==> ?B. &0 < B /\
                       !a b c d.
                          ball(0,B) SUBSET interval[a,b] /\
                          interval[a,b] SUBSET interval[c,d]
                          ==> abs(integral (interval[a,b])
                                    (\x. if x IN s then f x else 0) -
                                   integral (interval[c,d])
                                    (\x. if x IN s then f x else 0)) < e)``,
  REPEAT GEN_TAC THEN GEN_REWR_TAC LAND_CONV [INTEGRABLE_ALT] THEN
  ABBREV_TAC ``g:real->real = \x. if x IN s then f x else 0`` THEN
  POP_ASSUM(K ALL_TAC) THEN
  MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN
  DISCH_TAC THEN EQ_TAC THENL [MESON_TAC[SUBSET_TRANS], ALL_TAC] THEN
  DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  STRIP_TAC THEN EXISTS_TAC ``B:real`` THEN
  ASM_REWRITE_TAC[] THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``, ``c:real``, ``d:real``] THEN
  STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL
   [``(@f. f = max ((a:real)) ((c:real))):real``,
    ``(@f. f = min ((b:real)) ((d:real))):real``]) THEN
  ASM_SIMP_TAC std_ss [GSYM INTER_INTERVAL, SUBSET_INTER] THEN
  DISCH_THEN(fn th =>
    MP_TAC(ISPECL [``a:real``, ``b:real``] th) THEN
    MP_TAC(ISPECL [``c:real``, ``d:real``] th)) THEN
  ASM_SIMP_TAC std_ss [INTER_SUBSET] THEN
  GEN_REWR_TAC (RAND_CONV o RAND_CONV o RAND_CONV) [GSYM REAL_HALF] THEN REAL_ARITH_TAC);

val INTEGRABLE_ON_SUBINTERVAL = store_thm ("INTEGRABLE_ON_SUBINTERVAL",
 ``!f:real->real s a b.
        f integrable_on s /\ interval[a,b] SUBSET s
        ==> f integrable_on interval[a,b]``,
  REPEAT GEN_TAC THEN
  GEN_REWR_TAC (LAND_CONV o LAND_CONV) [INTEGRABLE_ALT] THEN
  DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o CONJUNCT1) ASSUME_TAC) THEN
  DISCH_THEN(MP_TAC o SPECL [``a:real``, ``b:real``]) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] INTEGRABLE_EQ) THEN
  ASM_SET_TAC[]);

Theorem INTEGRAL_SPLIT :
    !f:real->real a b t.
        f integrable_on interval[a,b]
        ==> (integral (interval[a,b]) f =
                integral(interval [a,(@f. f = min (b) t)]) f +
                integral(interval [(@f. f = max (a) t),b]) f)
Proof
    rpt STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE
 >> MATCH_MP_TAC HAS_INTEGRAL_SPLIT THEN EXISTS_TAC ``t:real``
 >> ASM_SIMP_TAC std_ss [INTERVAL_SPLIT, GSYM HAS_INTEGRAL_INTEGRAL]
 >> CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL
 >> EXISTS_TAC ``interval[a:real,b]``
 >> ASM_SIMP_TAC std_ss [SUBSET_INTERVAL, min_def, max_def]
 >> TRY COND_CASES_TAC
 >> rpt STRIP_TAC >> ASM_REAL_ARITH_TAC
QED

Theorem INTEGRAL_SPLIT_SIGNED :
    !f:real->real a b t.
        a <= t /\ a <= b /\
        f integrable_on interval[a,(@f. f = max (b) t)]
        ==> (integral (interval[a,b]) f =
                integral(interval
                 [a,(@f. f = t)]) f +
                (if b < t then -&1 else &1) *
                integral(interval [(@f. f = min (b) t), (@f. f = max (b) t)]) f)
Proof
  REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [] THENL
  [ (* goal 1 (of 2) *)
    MP_TAC(ISPECL
    [``f:real->real``, ``a:real``,
     ``(@f. f = t):real``, ``(b:real)``] INTEGRAL_SPLIT) THEN
    ASM_SIMP_TAC std_ss [] THEN KNOW_TAC ``f integrable_on interval [(a,t)]`` THENL
     [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
       (REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL)) THEN
      ASM_SIMP_TAC std_ss [SUBSET_INTERVAL] THEN
      REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN
      ASM_SIMP_TAC std_ss [max_def, REAL_LE_REFL] THEN
(* HOL's REAL_ASM_ARITH_TAC failed to solve:

        t <= if b <= t then t else b
   ------------------------------------
    0.  a <= t
    1.  a <= b
    2.  b < t
 *)
     `b <= t` by PROVE_TAC [REAL_LT_IMP_LE] >> fs [REAL_LE_REFL],

      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
      DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(REAL_ARITH
       ``(x = y) /\ (w = z)
        ==> (x:real = (y + z) + -(&1) * w)``) THEN
      CONJ_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
      SIMP_TAC std_ss [CONS_11, PAIR_EQ] THEN TRY CONJ_TAC THEN
      ASM_SIMP_TAC std_ss [min_def, max_def] THEN
      COND_CASES_TAC >> ASM_REAL_ARITH_TAC],
    (* goal 2 (of 2) *)
    MP_TAC(ISPECL
    [``f:real->real``, ``a:real``,
     ``b:real``, ``t:real``] INTEGRAL_SPLIT) THEN
    ASM_SIMP_TAC std_ss [] THEN KNOW_TAC ``f integrable_on interval [(a,b)]`` THENL
     [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
       (REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL)) THEN
      ASM_SIMP_TAC std_ss [SUBSET_INTERVAL] THEN
      REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN
      ASM_REWRITE_TAC[min_def, max_def, REAL_LE_REFL] THEN
      COND_CASES_TAC >> ASM_REAL_ARITH_TAC,

      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
      DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_MUL_LID] THEN
      BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
      SIMP_TAC std_ss [CONS_11, PAIR_EQ] THEN TRY CONJ_TAC THEN
      ASM_SIMP_TAC std_ss [min_def, max_def] THEN
      COND_CASES_TAC >> ASM_REAL_ARITH_TAC ] ]
QED

val lemma1 = prove (
   ``!f:(num->bool)->real n.
          sum {s | s SUBSET ((1:num)..SUC n)} f =
          sum {s | s SUBSET ((1:num)..n)} f +
          sum {s | s SUBSET ((1:num)..n)} (\s. f(SUC n INSERT s))``,
    REPEAT STRIP_TAC THEN
    REWRITE_TAC[NUMSEG_CLAUSES, ARITH_PROVE ``1 <= SUC n``, POWERSET_CLAUSES] THEN
    W(MP_TAC o PART_MATCH (lhs o rand) SUM_UNION o lhs o snd) THEN
    KNOW_TAC ``FINITE {s | s SUBSET ((1 :num) .. (n :num))} /\
     FINITE
       (IMAGE (\(s :num -> bool). SUC n INSERT s)
          {s | s SUBSET ((1 :num) .. n)}) /\
     DISJOINT {s | s SUBSET ((1 :num) .. n)}
       (IMAGE (\(s :num -> bool). SUC n INSERT s)
          {s | s SUBSET ((1 :num) .. n)}) `` THENL
     [ASM_SIMP_TAC std_ss [IMAGE_FINITE, FINITE_POWERSET, FINITE_NUMSEG] THEN
      REWRITE_TAC[SET_RULE
       ``DISJOINT s (IMAGE f t) <=> !x. x IN t ==> ~(f x IN s)``] THEN
      GEN_TAC THEN DISCH_TAC THEN SIMP_TAC std_ss [GSPECIFICATION, SUBSET_DEF] THEN
      EXISTS_TAC ``SUC n`` THEN
      REWRITE_TAC[IN_INSERT, IN_NUMSEG] THEN ARITH_TAC,
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
      DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN
      REWRITE_TAC [METIS [o_DEF] `` (\s. f (SUC n INSERT s)) =  f o (\s. SUC n INSERT s)``]
      THEN MATCH_MP_TAC (SUM_IMAGE) THEN
      SIMP_TAC std_ss [FINITE_POWERSET, FINITE_NUMSEG] THEN
      MAP_EVERY X_GEN_TAC [``s:num->bool``, ``t:num->bool``] THEN
      SIMP_TAC std_ss [GSPECIFICATION] THEN MATCH_MP_TAC(SET_RULE
       ``~(a IN i)
        ==> s SUBSET i /\ t SUBSET i /\ (a INSERT s = a INSERT t)
            ==> (s = t)``) THEN
      REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC]);

val lemma2 = prove (
   ``!f:real->real m a:real c:real d:real.
          f integrable_on univ(:real) /\ m <= (1:num) /\
          ((a = c) \/ (d = c)) /\
          ((a = c) ==> (a = d)) /\ ((a <= c) /\ (a <= d))
          ==> (integral(interval[a,d]) f =
                sum {s | s SUBSET ((1:num)..(m:num))}
                 (\s. -(&1) pow CARD {i | i IN s /\ d < c} *
                   integral
                    (interval[(@f. f = if (1:num) IN s then min c d else a:real),
                              (@f. f = if (1:num) IN s then max c d else c:real)]) f))``,
    GEN_TAC THEN INDUCT_TAC THENL
     [SIMP_TAC arith_ss [NUMSEG_CLAUSES, SUBSET_EMPTY, GSPEC_EQ, GSPEC_EQ2] THEN
      SIMP_TAC std_ss [SUM_SING, NOT_IN_EMPTY, GSPEC_F, CARD_EMPTY, CARD_INSERT] THEN
      REWRITE_TAC[pow, REAL_MUL_LID] THEN REPEAT GEN_TAC THEN
      REWRITE_TAC [IMP_CONJ] THEN REPEAT DISCH_TAC THEN
      ASM_CASES_TAC ``((a:real) = (c:real))``
      THENL
       [MATCH_MP_TAC(MESON[] ``(i = 0) /\ (j = 0) ==> (i:real = j)``) THEN
        CONJ_TAC THEN MATCH_MP_TAC INTEGRAL_NULL THEN
        REWRITE_TAC [CONTENT_EQ_0] THEN ASM_MESON_TAC[],
        SUBGOAL_THEN ``d:real = c:real`` (fn th => REWRITE_TAC[th]) THEN
        ASM_MESON_TAC[]],
      ALL_TAC] THEN
    REPEAT GEN_TAC THEN REWRITE_TAC [IMP_CONJ] THEN
    REPEAT DISCH_TAC THEN SIMP_TAC std_ss [lemma1] THEN
    SUBGOAL_THEN
     ``!s. s SUBSET ((1:num)..m)
          ==> (-(&1:real) pow CARD {i | i IN SUC m INSERT s /\ d < c} =
              (if (d:real) < (c:real) then -&1 else &1) *
              -(&1:real) pow CARD {i | i IN s /\ d < c})``
     (fn th => SIMP_TAC std_ss [th, GSPECIFICATION]) THENL
     [X_GEN_TAC ``s:num->bool`` THEN DISCH_TAC THEN
      SUBGOAL_THEN ``FINITE(s:num->bool)`` ASSUME_TAC THENL
       [ASM_MESON_TAC[FINITE_NUMSEG, FINITE_SUBSET], ALL_TAC] THEN
      COND_CASES_TAC THENL
       [ASM_SIMP_TAC std_ss [CARD_INSERT, FINITE_RESTRICT, SET_RULE
         ``({x | x IN a INSERT s} = a INSERT {x | x IN s})``,
         SET_RULE ``{x | x IN s} = s``] THEN
        RULE_ASSUM_TAC (SIMP_RULE arith_ss [ARITH_PROVE ``SUC m <= 1 <=> (m = 0)``]) THEN
        UNDISCH_TAC ``s SUBSET ((1:num) .. m)`` THEN
        ASM_REWRITE_TAC [NUMSEG_CLAUSES] THEN DISCH_TAC THEN
        RULE_ASSUM_TAC (SIMP_RULE arith_ss [SUBSET_DEF, NOT_IN_EMPTY]) THEN
        FIRST_ASSUM (ASSUME_TAC o SPEC ``1:num``) THEN ASM_SIMP_TAC arith_ss [pow],
        ASM_SIMP_TAC std_ss [REAL_MUL_LID, SET_RULE
         ``{x | x IN a INSERT s /\ F} = {x | x IN s /\ F}``]],
      ALL_TAC] THEN
    MP_TAC(ISPECL
     [``f:real->real``, ``a:real``, ``d:real``, ``(c:real)``]
         INTEGRAL_SPLIT_SIGNED) THEN SIMP_TAC std_ss [] THEN
    KNOW_TAC ``a <= c /\ a <= d:real /\ f integrable_on interval [(a,max d c)]`` THENL
     [ASM_MESON_TAC[ARITH_PROVE ``1 <= SUC n``, INTEGRABLE_ON_SUBINTERVAL,
                    SUBSET_UNIV], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
      POP_ASSUM K_TAC THEN DISCH_THEN SUBST1_TAC] THEN
    RULE_ASSUM_TAC (SIMP_RULE arith_ss [ARITH_PROVE ``SUC m <= 1 <=> (m = 0)``]) THEN
    ASM_SIMP_TAC arith_ss [NUMSEG_CLAUSES, SUBSET_DEF, NOT_IN_EMPTY] THEN
    SIMP_TAC std_ss [SET_RULE ``!s. (1:num) IN 1 INSERT s``] THEN
    KNOW_TAC ``!s. {(s:num->bool) | !x. x NOTIN s} = {{}}`` THENL
    [GEN_TAC THEN SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, IN_SING, NOT_IN_EMPTY] THEN
     GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [METIS_TAC [], ALL_TAC] THEN
     EXISTS_TAC ``x:num->bool`` THEN METIS_TAC [], DISCH_TAC] THEN
    ASM_SIMP_TAC std_ss [SUM_SING, IN_SING, NOT_IN_EMPTY] THEN BINOP_TAC THENL
    [SIMP_TAC real_ss [GSPEC_F, CARD_EMPTY, pow], ALL_TAC] THEN
    ASM_CASES_TAC ``d < c:real`` THENL [UNDISCH_TAC ``(a = c) ==> (c = d:real)`` THEN
     UNDISCH_TAC ``(a = c) \/ (d = c:real)`` THEN POP_ASSUM MP_TAC THEN
     REAL_ARITH_TAC, ALL_TAC] THEN
    ASM_SIMP_TAC std_ss [] THEN KNOW_TAC ``(c = d:real)`` THENL
    [UNDISCH_TAC ``(a = c) ==> (c = d:real)`` THEN
     UNDISCH_TAC ``(a = c) \/ (d = c:real)`` THEN POP_ASSUM MP_TAC THEN
     REAL_ARITH_TAC, SIMP_TAC real_ss [REAL_LE_LT, min_def, max_def]] THEN
     DISCH_TAC THEN SIMP_TAC real_ss [GSPEC_F, CARD_EMPTY, pow]);

val HAS_INTEGRAL_REFLECT_GEN = store_thm ("HAS_INTEGRAL_REFLECT_GEN",
 ``!f:real->real i s.
     ((\x. f(-x)) has_integral i) s <=> (f has_integral i) (IMAGE (\x. -x) s)``,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[HAS_INTEGRAL_ALT] THEN
  SIMP_TAC std_ss [] THEN
  GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV)
   [GSYM INTEGRABLE_REFLECT, GSYM INTEGRAL_REFLECT] THEN
  SIMP_TAC std_ss [IN_IMAGE, REAL_NEG_NEG] THEN
  REWRITE_TAC[UNWIND_THM1, REAL_ARITH ``(x:real = -y) <=> (-x = y)``] THEN
  KNOW_TAC ``!x:real. ?x'. -x = x'`` THENL
  [GEN_TAC THEN EXISTS_TAC ``-x:real`` THEN SIMP_TAC std_ss [],
   DISCH_TAC] THEN ASM_SIMP_TAC std_ss [] THEN
  ONCE_REWRITE_TAC [METIS []
       ``((\x. if -x IN s then f x else 0) integrable_on interval [(-b,-a)]) =
   (\a b. (\x. if -x IN s then f x else 0) integrable_on interval [(-b,-a)]) a b``] THEN
  ONCE_REWRITE_TAC [METIS []
   ``( ball (0,B) SUBSET interval [(a,b)] ==>
           abs
             (integral (interval [(-b,-a)])
                (\x. if -x IN s then f x else 0) - i) < e) =
     (\a b.  ball (0,B) SUBSET interval [(a,b)] ==>
           abs
             (integral (interval [(-b,-a)])
                (\x. if -x IN s then f x else 0) - i) < e) a b``] THEN
  GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV) [METIS [REAL_NEG_NEG]
   ``(!x:real y:real. P x y) <=> (!x y. P (-y) (-x))``] THEN
  SIMP_TAC std_ss [REAL_NEG_NEG] THEN
  SIMP_TAC std_ss [SUBSET_DEF, IN_BALL_0, GSYM REFLECT_INTERVAL, IN_IMAGE] THEN
  SIMP_TAC std_ss [UNWIND_THM1, REAL_ARITH ``(x:real = -y) <=> (-x = y)``] THEN
  ONCE_REWRITE_TAC[GSYM ABS_NEG] THEN
  ONCE_REWRITE_TAC [METIS []
       ``(abs (-x') < B ==> -x' IN interval [(x,y)]) =
    (\x'. abs (-x') < B ==> -x' IN interval [(x,y)]) x'``] THEN
  SIMP_TAC std_ss [METIS [REAL_NEG_NEG] ``(!x:real. P (-x)) <=> (!x. P x)``] THEN
  SIMP_TAC std_ss [ABS_NEG]);

val INTEGRABLE_REFLECT_GEN = store_thm ("INTEGRABLE_REFLECT_GEN",
 ``!f:real->real s.
        (\x. f(-x)) integrable_on s <=> f integrable_on (IMAGE (\x. -x) s)``,
  REWRITE_TAC[integrable_on, HAS_INTEGRAL_REFLECT_GEN]);

val INTEGRAL_REFLECT_GEN = store_thm ("INTEGRAL_REFLECT_GEN",
 ``!f:real->real s.
        integral s (\x. f(-x)) = integral (IMAGE (\x. -x) s) f``,
   REWRITE_TAC[integral, HAS_INTEGRAL_REFLECT_GEN]);

(* ------------------------------------------------------------------------- *)
(* A straddling criterion for integrability.                                 *)
(* ------------------------------------------------------------------------- *)

val INTEGRABLE_STRADDLE_INTERVAL = store_thm ("INTEGRABLE_STRADDLE_INTERVAL",
  ``!f:real->real a b.
        (!e. &0 < e
             ==> ?g h i j. (g has_integral i) (interval[a,b]) /\
                           (h has_integral j) (interval[a,b]) /\
                           abs(i - j) < e /\
                           !x. x IN interval[a,b]
                               ==> (g x) <= (f x) /\
                                   (f x) <= (h x))
        ==> f integrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[INTEGRABLE_CAUCHY] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &3:real``) THEN
  ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT, LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC
   [``g:real->real``, ``h:real->real``, ``i:real``, ``j:real``] THEN
  REWRITE_TAC[has_integral] THEN REWRITE_TAC[IMP_CONJ] THEN
  DISCH_THEN(MP_TAC o SPEC ``e / &3:real``) THEN
  ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT] THEN
  DISCH_THEN(X_CHOOSE_THEN ``d1:real->real->bool`` STRIP_ASSUME_TAC) THEN
  DISCH_THEN(MP_TAC o SPEC ``e / &3:real``) THEN
  ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT] THEN
  DISCH_THEN(X_CHOOSE_THEN ``d2:real->real->bool`` STRIP_ASSUME_TAC) THEN
  DISCH_TAC THEN DISCH_TAC THEN
  EXISTS_TAC ``(\x. d1 x INTER d2 x):real->real->bool`` THEN
  ASM_SIMP_TAC std_ss [GAUGE_INTER, FINE_INTER] THEN
  MAP_EVERY X_GEN_TAC
   [``p1:(real#(real->bool))->bool``,
    ``p2:(real#(real->bool))->bool``] THEN
  REPEAT STRIP_TAC THEN
  REPEAT(FIRST_X_ASSUM(fn th =>
   MP_TAC(SPEC ``p1:(real#(real->bool))->bool`` th) THEN
   MP_TAC(SPEC ``p2:(real#(real->bool))->bool`` th))) THEN
  UNDISCH_TAC ``(p2 :real # (real -> bool) -> bool) tagged_division_of
          interval [((a :real),(b :real))]`` THEN DISCH_TAC THEN
  FIRST_ASSUM (fn th => ASSUME_TAC(MATCH_MP TAGGED_DIVISION_OF_FINITE th)) THEN
  UNDISCH_TAC ``(p1 :real # (real -> bool) -> bool) tagged_division_of
          interval [((a :real),(b :real))]`` THEN DISCH_TAC THEN
  FIRST_ASSUM (fn th => ASSUME_TAC(MATCH_MP TAGGED_DIVISION_OF_FINITE th)) THEN
  ASM_SIMP_TAC std_ss [LAMBDA_PROD] THEN
  KNOW_TAC ``!f1 f2 g1 g2 h1 h2 i j.
             (g1 - h2 <= f1 - f2) /\ (f1 - f2 <= h1 - g2) /\
    abs(i - j) < e / &3
    ==> abs(g2 - i) < e / &3
        ==> abs(g1 - i) < e / &3
            ==> abs(h2 - j) < e / &3
                ==> abs(h1 - j) < e / &3
                    ==> abs(f1 - f2) < e:real`` THENL
  [REPEAT GEN_TAC THEN SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < &3:real``] THEN
   REAL_ARITH_TAC, DISCH_TAC] THEN
  FIRST_X_ASSUM (MATCH_MP_TAC) THEN
  ASM_SIMP_TAC std_ss [] THEN CONJ_TAC THEN
  MATCH_MP_TAC(REAL_ARITH ``x <= x' /\ y' <= y ==> x - y <= x' - y':real``) THEN
  CONJ_TAC THEN MATCH_MP_TAC SUM_LE THEN
  SIMP_TAC std_ss [FORALL_PROD] THEN REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC REAL_LE_LMUL_IMP THEN
  METIS_TAC[TAGGED_DIVISION_OF, CONTENT_POS_LE, SUBSET_DEF]);

val lemma = prove (
  ``&0:real <= x /\ x <= y ==> abs x <= abs y``,
   REAL_ARITH_TAC);

Theorem INTEGRABLE_STRADDLE :
    !f:real->real s.
        (!e. &0 < e
             ==> ?g h i j. (g has_integral i) s /\
                           (h has_integral j) s /\
                           abs(i - j) < e /\
                           !x. x IN s
                               ==> (g x) <= (f x) /\
                                   (f x) <= (h x))
        ==> f integrable_on s
Proof
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   ``!a b. (\x. if x IN s then (f:real->real) x else 0)
          integrable_on interval[a,b]``
  ASSUME_TAC THENL (* 2 subgoals *)
  [ (* goal 1 (of 2) *)
    RULE_ASSUM_TAC(REWRITE_RULE[HAS_INTEGRAL_ALT]) THEN
    MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN
    MATCH_MP_TAC INTEGRABLE_STRADDLE_INTERVAL THEN
    X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``e / &4:real``) THEN
    ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT] THEN
    SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC
     [``g:real->real``, ``h:real->real``, ``i:real``, ``j:real``] THEN
    REWRITE_TAC[GSYM CONJ_ASSOC] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC ``e / &4:real``) MP_TAC) THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC ``e / &4:real``) STRIP_ASSUME_TAC) THEN
    ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT] THEN
    DISCH_THEN(X_CHOOSE_THEN ``B2:real``
     (ASSUME_TAC)) THEN
    DISCH_THEN(X_CHOOSE_THEN ``B1:real``
     (ASSUME_TAC)) THEN
    MAP_EVERY EXISTS_TAC
     [``\x. if x IN s then (g:real->real) x else 0``,
      ``\x. if x IN s then (h:real->real) x else 0``,
      ``integral(interval[a:real,b])
         (\x. if x IN s then (g:real->real) x else 0:real)``,
      ``integral(interval[a:real,b])
         (\x. if x IN s then (h:real->real) x else 0:real)``] THEN
    ASM_SIMP_TAC std_ss [INTEGRABLE_INTEGRAL] THEN
    CONJ_TAC THENL [ALL_TAC, METIS_TAC[REAL_LE_REFL]] THEN
    ABBREV_TAC ``c:real = @f. f = min ((a:real)) (-(max B1 B2))`` THEN
    ABBREV_TAC ``d:real = @f. f = max ((b:real)) (max B1 B2)`` THEN
    UNDISCH_TAC `` 0 < B2 /\
          !a b.
            ball (0,B2) SUBSET interval [(a,b)] ==>
            abs
              (integral (interval [(a,b)]) (\x. if x IN s then h x else 0) -
               j) < e / 4:real`` THEN STRIP_TAC THEN
    POP_ASSUM (MP_TAC o SPECL [``c:real``, ``d:real``]) THEN
    UNDISCH_TAC ``0 < B1 /\
          !a b.
            ball (0,B1) SUBSET interval [(a,b)] ==>
            abs
              (integral (interval [(a,b)]) (\x. if x IN s then g x else 0) -
               i) < e / 4:real`` THEN STRIP_TAC THEN
    POP_ASSUM (MP_TAC o SPECL [``c:real``, ``d:real``]) THEN
    MATCH_MP_TAC(TAUT
        `(a /\ c) /\ (b /\ d ==> e) ==> (a ==> b) ==> (c ==> d) ==> e`) THEN
    CONJ_TAC THENL
    [ CONJ_TAC THEN MAP_EVERY EXPAND_TAC ["c", "d"] THEN
      SIMP_TAC std_ss [SUBSET_DEF, IN_BALL, IN_INTERVAL] THEN
      GEN_TAC THEN REWRITE_TAC[DIST_0] THEN DISCH_TAC THEN (* 2 goals *)
 (* TODO: a common lemma between min,max,abs *)
      (Know `!x B:real. abs(x) <= B ==> min a (-B) <= x /\ x <= max b B`
       >- (rpt GEN_TAC \\
          DISCH_THEN (STRIP_ASSUME_TAC o REWRITE_RULE [ABS_BOUNDS]) \\
          PROVE_TAC [REAL_LE_MAX, REAL_MIN_LE]) \\
       DISCH_THEN MATCH_MP_TAC) THEN
      MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``abs(x:real)`` THEN
      ASM_SIMP_TAC std_ss [REAL_LT_IMP_LE, REAL_LE_MAX, REAL_LE_REFL],
      ALL_TAC ] THEN

    KNOW_TAC ``!ah ag ch cg.
            abs(i - j) < e / &4:real /\
         abs(ah - ag) <= abs(ch - cg)
        ==> abs(cg - i) < e / &4 /\
            abs(ch - j) < e / &4
            ==> abs(ag - ah) < e`` THENL
    [REPEAT GEN_TAC THEN
         SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 4:real``] THEN
     REAL_ARITH_TAC, DISCH_TAC] THEN
    FIRST_X_ASSUM (MATCH_MP_TAC) THEN
    ASM_SIMP_TAC std_ss [] THEN ASM_SIMP_TAC std_ss [GSYM INTEGRAL_SUB] THEN
    MATCH_MP_TAC lemma THEN CONJ_TAC THENL
    [ MATCH_MP_TAC(HAS_INTEGRAL_DROP_POS) THEN
      MAP_EVERY EXISTS_TAC
       [``(\x. (if x IN s then h x else 0) - (if x IN s then g x else 0))
         :real->real``,
        ``interval[a:real,b]``] THEN
      ASM_SIMP_TAC std_ss [INTEGRABLE_INTEGRAL, HAS_INTEGRAL_SUB] THEN
      ASM_SIMP_TAC std_ss [INTEGRABLE_SUB, INTEGRABLE_INTEGRAL] THEN
      REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
      ASM_SIMP_TAC std_ss [REAL_SUB_LE, REAL_POS] THEN
      ASM_MESON_TAC[REAL_LE_TRANS],
      ALL_TAC] THEN
    MATCH_MP_TAC (HAS_INTEGRAL_SUBSET_DROP_LE) THEN
    MAP_EVERY EXISTS_TAC
     [``(\x. (if x IN s then h x else 0) - (if x IN s then g x else 0))
       :real->real``,
      ``interval[a:real,b]``, ``interval[c:real,d]``] THEN
    ASM_SIMP_TAC std_ss [INTEGRABLE_SUB, INTEGRABLE_INTEGRAL] THEN CONJ_TAC THENL
    [ REWRITE_TAC[SUBSET_INTERVAL] THEN DISCH_TAC THEN
      MAP_EVERY EXPAND_TAC ["c", "d"] THEN
      SIMP_TAC std_ss [] \\
      PROVE_TAC [REAL_MIN_LE, REAL_LE_MAX, REAL_LE_REFL],
      ALL_TAC ] THEN
    REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
    ASM_SIMP_TAC std_ss [REAL_SUB_LE, REAL_POS] THEN
    ASM_MESON_TAC[REAL_LE_TRANS],
  ALL_TAC] THEN

  ONCE_REWRITE_TAC[INTEGRABLE_ALT] THEN ASM_REWRITE_TAC[] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  UNDISCH_TAC`` !(e :real). (0 :real) < e ==>
            ?(g :real -> real) (h :real -> real) (i :real) (j :real).
              (g has_integral i) (s :real -> bool) /\
              (h has_integral j) s /\ abs (i - j) < e /\
              !(x :real).
                x IN s ==> g x <= (f :real -> real) x /\ f x <= h x`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &3:real``) THEN
  ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT] THEN
  ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM, HAS_INTEGRAL_ALT] THEN
  MAP_EVERY X_GEN_TAC
   [``g:real->real``, ``h:real->real``, ``i:real``, ``j:real``] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC ``e / &3:real``)) THEN
  FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC ``e / &3:real``)) THEN
  ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT] THEN
  DISCH_THEN(X_CHOOSE_THEN ``B1:real`` (ASSUME_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN ``B2:real`` (ASSUME_TAC)) THEN
  EXISTS_TAC ``max B1 B2:real`` THEN
  ASM_SIMP_TAC std_ss [REAL_LT_MAX, BALL_MAX_UNION, UNION_SUBSET] THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``, ``c:real``, ``d:real``] THEN
  STRIP_TAC THEN REWRITE_TAC[] THEN
  KNOW_TAC ``e = e / &3 + e / &3 + e / &3:real`` THENL
  [REWRITE_TAC [GSYM REAL_ADD_RDISTRIB, real_div] THEN REWRITE_TAC [GSYM real_div] THEN
   SIMP_TAC std_ss [REAL_EQ_RDIV_EQ, REAL_ARITH ``0 < 3:real``] THEN REAL_ARITH_TAC,
   DISCH_TAC THEN ONCE_ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  MATCH_MP_TAC(REAL_ARITH
   ``!ga gc ha hc i j.
        ga <= fa /\ fa <= ha /\
        gc <= fc /\ fc <= hc /\
        abs(ga - i) < e / &3 /\
        abs(gc - i) < e / &3 /\
        abs(ha - j) < e / &3 /\
        abs(hc - j) < e / &3 /\
        abs(i - j) < e / &3
        ==> abs(fa - fc) < e / &3 + e / &3 + e / &3:real``) THEN
  MAP_EVERY EXISTS_TAC
   [``(integral(interval[a:real,b]) (\x. if x IN s then g x else 0))``,
    ``(integral(interval[c:real,d]) (\x. if x IN s then g x else 0))``,
    ``(integral(interval[a:real,b]) (\x. if x IN s then h x else 0))``,
    ``(integral(interval[c:real,d]) (\x. if x IN s then h x else 0))``,
    ``i:real``, ``j:real``] THEN
  ASM_SIMP_TAC std_ss [] THEN
  REPEAT CONJ_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN
  ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN BETA_TAC THEN
  COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [REAL_LE_REFL]
QED

val HAS_INTEGRAL_STRADDLE_NULL = store_thm ("HAS_INTEGRAL_STRADDLE_NULL",
 ``!f g:real->real s.
        (!x. x IN s ==> &0 <= (f x) /\ (f x) <= (g x)) /\
        (g has_integral (0)) s
        ==> (f has_integral (0)) s``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN
  MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
   [MATCH_MP_TAC INTEGRABLE_STRADDLE THEN
    GEN_TAC THEN DISCH_TAC THEN
    MAP_EVERY EXISTS_TAC
     [``(\x. 0):real->real``, ``g:real->real``,
      ``0:real``, ``0:real``] THEN
    ASM_SIMP_TAC std_ss [HAS_INTEGRAL_0, REAL_SUB_REFL, ABS_0],
    DISCH_TAC THEN
    REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL
     [MATCH_MP_TAC(ISPECL [``f:real->real``, ``g:real->real``]
        HAS_INTEGRAL_DROP_LE),
      MATCH_MP_TAC(ISPECL [``(\x. 0):real->real``, ``f:real->real``]
        HAS_INTEGRAL_DROP_LE)] THEN
    EXISTS_TAC ``s:real->bool`` THEN
    ASM_SIMP_TAC std_ss [GSYM HAS_INTEGRAL_INTEGRAL, HAS_INTEGRAL_0]]);

(* ------------------------------------------------------------------------- *)
(* Adding integrals over several sets.                                       *)
(* ------------------------------------------------------------------------- *)

val HAS_INTEGRAL_UNION = store_thm ("HAS_INTEGRAL_UNION",
 ``!f:real->real i j s t.
        (f has_integral i) s /\ (f has_integral j) t /\ negligible(s INTER t)
        ==> (f has_integral (i + j)) (s UNION t)``,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN
  REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
  MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN
  EXISTS_TAC ``(\x. if x IN (s INTER t) then (&2:real) * f(x)
                   else if x IN (s UNION t) then f(x)
                   else 0:real):real->real`` THEN
  EXISTS_TAC ``s INTER t:real->bool`` THEN
  ASM_SIMP_TAC std_ss [IN_DIFF, IN_UNION, IN_INTER, IN_UNIV] THEN
  CONJ_TAC THENL [METIS_TAC[], ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP HAS_INTEGRAL_ADD) THEN
  MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
  REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN
  MAP_EVERY ASM_CASES_TAC [``(x:real) IN s``, ``(x:real) IN t``] THEN
  ASM_SIMP_TAC std_ss[] THEN REAL_ARITH_TAC);

val INTEGRAL_UNION = store_thm ("INTEGRAL_UNION",
 ``!f:real->real s t.
        f integrable_on s /\ f integrable_on t /\ negligible(s INTER t)
        ==> (integral (s UNION t) f = integral s f + integral t f)``,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC INTEGRAL_UNIQUE THEN
  MATCH_MP_TAC HAS_INTEGRAL_UNION THEN
  ASM_SIMP_TAC std_ss [GSYM HAS_INTEGRAL_INTEGRAL]);

val HAS_INTEGRAL_BIGUNION = store_thm ("HAS_INTEGRAL_BIGUNION",
 ``!f:real->real i t.
        FINITE t /\
        (!s. s IN t ==> (f has_integral (i s)) s) /\
        (!s s'. s IN t /\ s' IN t /\ ~(s = s') ==> negligible(s INTER s'))
        ==> (f has_integral (sum t i)) (BIGUNION t)``,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN
  REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  DISCH_TAC THEN POP_ASSUM (MP_TAC o ONCE_REWRITE_RULE [METIS []
   ``!s:real->bool. (\x. if x IN s then (f:real->real) x else 0:real) =
               (\s. (\x. if x IN s then f x else 0:real)) s``]) THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HAS_INTEGRAL_SUM) THEN SIMP_TAC std_ss [] THEN
  MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`]
                HAS_INTEGRAL_SPIKE) THEN
  EXISTS_TAC ``BIGUNION (IMAGE (\(a,b). a INTER b :real->bool)
                  {(a,b) | a IN t /\ b IN {y | y IN t /\ ~(a = y)}})`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC NEGLIGIBLE_BIGUNION THEN CONJ_TAC THENL
     [MATCH_MP_TAC IMAGE_FINITE THEN
      ONCE_REWRITE_TAC [METIS []
      `` {(a,b) | a IN t /\ b IN {y | y IN t /\ a <> y}} =
    {(\a b. (a,b)) a b | a IN t /\ b IN (\a. {y | y IN t /\ a <> y}) a}``] THEN
     MATCH_MP_TAC FINITE_PRODUCT_DEPENDENT THEN
      ASM_SIMP_TAC std_ss [FINITE_RESTRICT],
      SIMP_TAC std_ss [FORALL_IN_IMAGE, FORALL_PROD, IN_ELIM_PAIR_THM] THEN
      ASM_SIMP_TAC std_ss [GSPECIFICATION]],
    X_GEN_TAC ``x:real`` THEN REWRITE_TAC[IN_UNIV, IN_DIFF] THEN
    ASM_CASES_TAC ``(x:real) IN BIGUNION t`` THEN ASM_SIMP_TAC std_ss [] THENL
     [ALL_TAC,
      RULE_ASSUM_TAC(REWRITE_RULE[SET_RULE
       ``~(x IN BIGUNION t) <=> !s. s IN t ==> ~(x IN s)``]) THEN
       DISCH_TAC THEN ONCE_REWRITE_TAC [METIS [SUM_0]
        ``0 = sum (t :(real -> bool) -> bool) (\(a :real -> bool). 0)``] THEN
        MATCH_MP_TAC SUM_EQ THEN GEN_TAC THEN DISCH_TAC THEN
                ASM_SIMP_TAC std_ss [SUM_0]] THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [IN_BIGUNION]) THEN
    DISCH_THEN(X_CHOOSE_THEN ``a:real->bool`` STRIP_ASSUME_TAC) THEN
    REWRITE_TAC [IN_BIGUNION] THEN ONCE_REWRITE_TAC [CONJ_SYM] THEN
    ONCE_REWRITE_TAC [METIS [SPECIFICATION]
         ``x IN (s:real->bool) <=> (\s. x IN s) s``] THEN
    REWRITE_TAC [EXISTS_IN_IMAGE] THEN BETA_TAC THEN
    ONCE_REWRITE_TAC [METIS []
         ``(x' IN {(a,b) | a IN t /\ b IN {y | y IN t /\ a <> y}} /\
        x IN (\(a,b). a INTER b) x') <=>
        (\x'. x' IN {(a,b) | a IN t /\ b IN {y | y IN t /\ a <> y}} /\
        x IN (\(a,b). a INTER b) x') x'``] THEN
    REWRITE_TAC [EXISTS_PROD] THEN BETA_TAC THEN
    REWRITE_TAC [LAMBDA_PAIR] THEN BETA_TAC THEN REWRITE_TAC [FST, SND] THEN
    SIMP_TAC std_ss [IN_ELIM_PAIR_THM, NOT_EXISTS_THM] THEN
    ONCE_REWRITE_TAC [METIS [] ``a NOTIN b <=> ~(a IN b)``, GSYM DE_MORGAN_THM] THEN
    ONCE_REWRITE_TAC [METIS [] ``a NOTIN b <=> ~(a IN b)``, GSYM DE_MORGAN_THM] THEN
    DISCH_THEN(MP_TAC o SPEC ``a:real->bool``) THEN
    ASM_SIMP_TAC std_ss [GSPECIFICATION, IN_INTER] THEN
    ONCE_REWRITE_TAC [METIS [] ``a NOTIN b <=> ~(a IN b)``, GSYM DE_MORGAN_THM,
                      METIS [] ``(a = b) <=> ~(a <> b)``] THEN
    ONCE_REWRITE_TAC [METIS [] ``a NOTIN b <=> ~(a IN b)``, GSYM DE_MORGAN_THM,
                      METIS [] ``(a = b) <=> ~(a <> b)``] THEN
    ONCE_REWRITE_TAC [METIS [] ``a NOTIN b <=> ~(a IN b)``, GSYM DE_MORGAN_THM,
                      METIS [] ``(a = b) <=> ~(a <> b)``] THEN
     ASM_SIMP_TAC std_ss [METIS[]
     ``x IN a /\ a IN t
      ==> ((!b. ~((b IN t /\ ~(a = b)) /\ x IN b)) <=>
           (!b. b IN t ==> (x IN b <=> (b = a))))``] THEN DISCH_TAC THEN
    KNOW_TAC ``sum (t :(real -> bool) -> bool)
      (\(a :real -> bool). if x IN a then f x else (0 :real)) =
      sum (t :(real -> bool) -> bool)
      (\(b :real -> bool). if (b :real -> bool) = a then f x else (0 :real))`` THENL
    [MATCH_MP_TAC SUM_EQ THEN METIS_TAC [], DISCH_TAC THEN ASM_REWRITE_TAC []] THEN
    ASM_SIMP_TAC std_ss [SUM_DELTA]]);

val HAS_INTEGRAL_DIFF = store_thm ("HAS_INTEGRAL_DIFF",
 ``!f:real->real i j s t.
    (f has_integral i) s /\
    (f has_integral j) t /\
    negligible (t DIFF s)
    ==> (f has_integral (i - j)) (s DIFF t)``,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN
  REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
  MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN
  EXISTS_TAC ``(\x. if x IN (t DIFF s) then -(f x)
                   else if x IN (s DIFF t) then f x
                   else 0):real->real`` THEN
  EXISTS_TAC ``t DIFF s:real->bool`` THEN
  ASM_REWRITE_TAC[IN_DIFF, IN_UNION, IN_INTER, IN_UNIV] THEN
  CONJ_TAC THENL [METIS_TAC[], ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB) THEN
  MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
  REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN
  MAP_EVERY ASM_CASES_TAC [``(x:real) IN s``, ``(x:real) IN t``] THEN
  ASM_SIMP_TAC std_ss [] THEN REAL_ARITH_TAC);

val INTEGRAL_DIFF = store_thm ("INTEGRAL_DIFF",
 ``!f:real->real s t.
        f integrable_on s /\ f integrable_on t /\ negligible(t DIFF s)
        ==> (integral (s DIFF t) f = integral s f - integral t f)``,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC INTEGRAL_UNIQUE THEN
  MATCH_MP_TAC HAS_INTEGRAL_DIFF THEN
  ASM_SIMP_TAC std_ss [GSYM HAS_INTEGRAL_INTEGRAL]);

(* ------------------------------------------------------------------------------ *)
(* In particular adding integrals over a division, maybe not of an interval. 7044 *)
(* ------------------------------------------------------------------------------ *)

val HAS_INTEGRAL_COMBINE_DIVISION = store_thm ("HAS_INTEGRAL_COMBINE_DIVISION",
 ``!f:real->real s d i.
        d division_of s /\
        (!k. k IN d ==> (f has_integral (i k)) k)
        ==> (f has_integral (sum d i)) s``,
  REPEAT STRIP_TAC THEN
  UNDISCH_TAC ``d division_of s`` THEN DISCH_TAC THEN
  FIRST_ASSUM(SUBST1_TAC o SYM o last o CONJUNCTS o
              REWRITE_RULE [division_of]) THEN
  MATCH_MP_TAC HAS_INTEGRAL_BIGUNION THEN ASM_REWRITE_TAC[] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_FINITE], ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [``k1:real->bool``, ``k2:real->bool``] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN ``?u v:real x y:real.
                (k1 = interval[u,v]) /\ (k2 = interval[x,y])``
   (REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN SUBST_ALL_TAC))
  THENL [ASM_MESON_TAC[division_of], ALL_TAC] THEN
  UNDISCH_TAC ``d division_of s`` THEN GEN_REWR_TAC LAND_CONV [division_of] THEN
  DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  DISCH_THEN(MP_TAC o SPECL
   [``interval[u:real,v]``, ``interval[x:real,y]``]) THEN
  ASM_REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN DISCH_TAC THEN
  MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
  EXISTS_TAC ``(interval[u,v:real] DIFF interval(u,v)) UNION
               (interval[x,y] DIFF interval(x,y))`` THEN
  SIMP_TAC std_ss [NEGLIGIBLE_FRONTIER_INTERVAL, NEGLIGIBLE_UNION] THEN
  ASM_SET_TAC[]);

val INTEGRAL_COMBINE_DIVISION_BOTTOMUP = store_thm ("INTEGRAL_COMBINE_DIVISION_BOTTOMUP",
 ``!f:real->real d s.
        d division_of s /\ (!k. k IN d ==> f integrable_on k)
        ==> (integral s f = sum d (\i. integral i f))``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN
  MATCH_MP_TAC HAS_INTEGRAL_COMBINE_DIVISION THEN
  ASM_SIMP_TAC std_ss [GSYM HAS_INTEGRAL_INTEGRAL]);

val HAS_INTEGRAL_COMBINE_DIVISION_TOPDOWN = store_thm ("HAS_INTEGRAL_COMBINE_DIVISION_TOPDOWN",
 ``!f:real->real s d k.
        f integrable_on s /\ d division_of k /\ k SUBSET s
        ==> (f has_integral (sum d (\i. integral i f))) k``,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC HAS_INTEGRAL_COMBINE_DIVISION THEN
  ASM_SIMP_TAC std_ss [GSYM HAS_INTEGRAL_INTEGRAL] THEN
  FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN
  EXISTS_TAC ``s:real->bool`` THEN ASM_SIMP_TAC std_ss [] THEN
  METIS_TAC[division_of, SUBSET_TRANS]);

val INTEGRAL_COMBINE_DIVISION_TOPDOWN = store_thm ("INTEGRAL_COMBINE_DIVISION_TOPDOWN",
 ``!f:real->real d s.
        f integrable_on s /\ d division_of s
        ==> (integral s f = sum d (\i. integral i f))``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN
  MATCH_MP_TAC HAS_INTEGRAL_COMBINE_DIVISION_TOPDOWN THEN
  EXISTS_TAC ``s:real->bool`` THEN ASM_SIMP_TAC std_ss [SUBSET_REFL]);

val INTEGRABLE_COMBINE_DIVISION = store_thm ("INTEGRABLE_COMBINE_DIVISION",
 ``!f d s.
        d division_of s /\ (!i. i IN d ==> f integrable_on i)
        ==> f integrable_on s``,
  REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_COMBINE_DIVISION]);

val INTEGRABLE_ON_SUBDIVISION = store_thm ("INTEGRABLE_ON_SUBDIVISION",
 ``!f:real->real s d i.
        d division_of i /\
        f integrable_on s /\ i SUBSET s
        ==> f integrable_on i``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_COMBINE_DIVISION THEN
  EXISTS_TAC ``d:(real->bool)->bool`` THEN ASM_REWRITE_TAC[] THEN
  FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN
  ASM_MESON_TAC[division_of, BIGUNION_SUBSET]);

(* ------------------------------------------------------------------------- *)
(* Also tagged divisions.                                                    *)
(* ------------------------------------------------------------------------- *)

val HAS_INTEGRAL_COMBINE_TAGGED_DIVISION = store_thm ("HAS_INTEGRAL_COMBINE_TAGGED_DIVISION",
 ``!f:real->real s p i.
        p tagged_division_of s /\
        (!x k. (x,k) IN p ==> (f has_integral (i k)) k)
        ==> (f has_integral (sum p (\(x,k). i k))) s``,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   ``!x:real k:real->bool.
      (x,k) IN p ==> ((f:real->real) has_integral integral k f) k``
  ASSUME_TAC THENL
   [ASM_MESON_TAC[HAS_INTEGRAL_INTEGRAL, integrable_on], ALL_TAC] THEN
  SUBGOAL_THEN
   ``((f:real->real) has_integral
     (sum (IMAGE SND (p:real#(real->bool)->bool))
           (\k. integral k f))) s``
  MP_TAC THENL
   [MATCH_MP_TAC HAS_INTEGRAL_COMBINE_DIVISION THEN
    ASM_SIMP_TAC std_ss [FORALL_IN_IMAGE, FORALL_PROD] THEN
    ASM_SIMP_TAC std_ss [DIVISION_OF_TAGGED_DIVISION] THEN METIS_TAC [],
    ALL_TAC] THEN
  MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN
  AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN
  MATCH_MP_TAC EQ_TRANS THEN
  EXISTS_TAC ``sum p (\(x:real,k:real->bool). integral k f:real)`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC SUM_EQ THEN SIMP_TAC std_ss [FORALL_PROD] THEN
    ASM_MESON_TAC[HAS_INTEGRAL_UNIQUE],
    GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV)
     [METIS [] ``integral (k :real -> bool) f = (\k. integral k f) k``] THEN
    MATCH_MP_TAC SUM_OVER_TAGGED_DIVISION_LEMMA THEN
    EXISTS_TAC ``s:real->bool`` THEN ASM_SIMP_TAC std_ss [INTEGRAL_NULL]]);

val INTEGRAL_COMBINE_TAGGED_DIVISION_BOTTOMUP = store_thm ("INTEGRAL_COMBINE_TAGGED_DIVISION_BOTTOMUP",
 ``!f:real->real p a b.
        p tagged_division_of interval[a,b] /\
        (!x k. (x,k) IN p ==> f integrable_on k)
        ==> (integral (interval[a,b]) f = sum p (\(x,k). integral k f))``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN
  ONCE_REWRITE_TAC
     [METIS [] ``integral (k :real -> bool) f = (\k. integral k f) k``] THEN
  MATCH_MP_TAC HAS_INTEGRAL_COMBINE_TAGGED_DIVISION THEN
  ASM_SIMP_TAC std_ss [GSYM HAS_INTEGRAL_INTEGRAL] THEN METIS_TAC []);

val HAS_INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN = store_thm ("HAS_INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN",
 ``!f:real->real a b p.
        f integrable_on interval[a,b] /\ p tagged_division_of interval[a,b]
        ==> (f has_integral (sum p (\(x,k). integral k f))) (interval[a,b])``,
  REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC
     [METIS [] ``integral (k :real -> bool) f = (\k. integral k f) k``] THEN
  MATCH_MP_TAC HAS_INTEGRAL_COMBINE_TAGGED_DIVISION THEN
  ASM_SIMP_TAC std_ss [GSYM HAS_INTEGRAL_INTEGRAL] THEN
  ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL, TAGGED_DIVISION_OF]);

val INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN = store_thm ("INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN",
 ``!f:real->real a b p.
        f integrable_on interval[a,b] /\ p tagged_division_of interval[a,b]
        ==> (integral (interval[a,b]) f = sum p (\(x,k). integral k f))``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN
  MATCH_MP_TAC HAS_INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN THEN
  ASM_SIMP_TAC std_ss []);

(* ------------------------------------------------------------------------- *)
(* Henstock's lemma.                          7180                           *)
(* ------------------------------------------------------------------------- *)

val lemma = prove (
  ``(!k. &0 < k ==> x <= e + k) ==> x <= e:real``,
   DISCH_THEN(MP_TAC o SPEC ``(x - e) / &2:real``) THEN
   ONCE_REWRITE_TAC [REAL_ADD_SYM] THEN REWRITE_TAC [GSYM REAL_LE_SUB_RADD] THEN
   SIMP_TAC std_ss [REAL_LE_RDIV_EQ, REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
   REAL_ARITH_TAC);

val HENSTOCK_LEMMA_PART1 = store_thm ("HENSTOCK_LEMMA_PART1",
 ``!f:real->real a b d e.
        f integrable_on interval[a,b] /\
        &0 < e /\ gauge d /\
        (!p. p tagged_division_of interval[a,b] /\ d FINE p
             ==> abs (sum p (\(x,k). content k * f x) -
                       integral(interval[a,b]) f) < e)
        ==> !p. p tagged_partial_division_of interval[a,b] /\ d FINE p
                            ==> abs(sum p (\(x,k). content k * f x -
                                                     integral k f)) <= e``,
  REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC lemma THEN X_GEN_TAC ``k:real`` THEN DISCH_TAC THEN
  MP_TAC(ISPECL
    [``IMAGE SND (p:(real#(real->bool))->bool)``, ``a:real``, ``b:real``]
    PARTIAL_DIVISION_EXTEND_INTERVAL) THEN
  KNOW_TAC ``IMAGE (SND :real # (real -> bool) -> real -> bool)
       (p :real # (real -> bool) -> bool) division_of
     BIGUNION (IMAGE (SND :real # (real -> bool) -> real -> bool) p) /\
     BIGUNION (IMAGE (SND :real # (real -> bool) -> real -> bool) p) SUBSET
     interval [((a :real),(b :real))]`` THENL
   [CONJ_TAC THENL
     [ASM_MESON_TAC[PARTIAL_DIVISION_OF_TAGGED_DIVISION], ALL_TAC] THEN
    SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_BIGUNION] THEN
    SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM, FORALL_IN_IMAGE] THEN
    SIMP_TAC std_ss [FORALL_PROD] THEN
    ASM_MESON_TAC[tagged_partial_division_of, SUBSET_DEF],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  SUBGOAL_THEN ``FINITE(p:(real#(real->bool))->bool)`` ASSUME_TAC THENL
   [ASM_MESON_TAC[tagged_partial_division_of], ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN ``q:(real->bool)->bool`` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP(SET_RULE
   ``s SUBSET t ==> (t = s UNION (t DIFF s))``)) THEN
  ABBREV_TAC ``r = q DIFF IMAGE SND (p:(real#(real->bool))->bool)`` THEN
  SUBGOAL_THEN ``IMAGE SND (p:(real#(real->bool))->bool) INTER r = {}``
  ASSUME_TAC THENL [EXPAND_TAC "r" THEN SET_TAC[], ALL_TAC] THEN
  DISCH_THEN SUBST_ALL_TAC THEN
  SUBGOAL_THEN ``FINITE(r:(real->bool)->bool)`` ASSUME_TAC THENL
   [ASM_MESON_TAC[division_of, FINITE_UNION], ALL_TAC] THEN
  SUBGOAL_THEN
   ``!i. i IN r
        ==> ?p. p tagged_division_of i /\ d FINE p /\
                abs(sum p (\(x,j). content j * f x) -
                     integral i (f:real->real))
                < k / (&(CARD(r:(real->bool)->bool)) + &1)``
  MP_TAC THENL
   [X_GEN_TAC ``i:real->bool`` THEN DISCH_TAC THEN
    SUBGOAL_THEN ``(i:real->bool) SUBSET interval[a,b]`` ASSUME_TAC THENL
     [ASM_MESON_TAC[division_of, IN_UNION], ALL_TAC] THEN
    SUBGOAL_THEN ``?u v:real. i = interval[u,v]``
     (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC)
    THENL [ASM_MESON_TAC[division_of, IN_UNION], ALL_TAC] THEN
    SUBGOAL_THEN ``(f:real->real) integrable_on interval[u,v]`` MP_TAC THENL
     [ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL], ALL_TAC] THEN
    DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN
    REWRITE_TAC[has_integral] THEN
    DISCH_THEN(MP_TAC o SPEC ``k / (&(CARD(r:(real->bool)->bool)) + &1:real)``) THEN
    ASM_SIMP_TAC std_ss [REAL_LT_DIV,
     METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0] ``&0 < &n + &1:real``] THEN
    DISCH_THEN(X_CHOOSE_THEN ``dd:real->real->bool`` MP_TAC) THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    MP_TAC(ISPECL [``d:real->real->bool``, ``dd:real->real->bool``]
      GAUGE_INTER) THEN
    ASM_REWRITE_TAC[] THEN
    DISCH_THEN(MP_TAC o MATCH_MP FINE_DIVISION_EXISTS) THEN
    DISCH_THEN(MP_TAC o SPECL [``u:real``, ``v:real``]) THEN
    REWRITE_TAC[FINE_INTER] THEN MESON_TAC[],
    ALL_TAC] THEN
  SIMP_TAC std_ss [RIGHT_IMP_EXISTS_THM, SKOLEM_THM] THEN
  REWRITE_TAC[TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN
  SIMP_TAC std_ss [FORALL_AND_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN ``q:(real->bool)->(real#(real->bool))->bool``
    STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC
    ``p UNION BIGUNION {q (i:real->bool) | i IN r}
     :(real#(real->bool))->bool``) THEN
  KNOW_TAC ``(p :real # (real -> bool) -> bool) UNION
     BIGUNION
       {(q :(real -> bool) -> real # (real -> bool) -> bool) i |
        i IN (r :(real -> bool) -> bool)} tagged_division_of
     interval [((a :real),(b :real))] /\
     (d :real -> real -> bool) FINE p UNION BIGUNION {q i | i IN r}`` THENL
   [CONJ_TAC THENL
     [ALL_TAC,
      MATCH_MP_TAC FINE_UNION THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC FINE_BIGUNION THEN ONCE_REWRITE_TAC[GSYM IMAGE_DEF] THEN
      ASM_SIMP_TAC std_ss [FORALL_IN_IMAGE]] THEN
    UNDISCH_TAC ``IMAGE (SND :real # (real -> bool) -> real -> bool)
            (p :real # (real -> bool) -> bool) UNION
          (r :(real -> bool) -> bool) division_of
          interval [((a :real),(b :real))]`` THEN DISCH_TAC THEN
    FIRST_ASSUM(SUBST1_TAC o SYM o last o CONJUNCTS o
                REWRITE_RULE [division_of]) THEN
    REWRITE_TAC[BIGUNION_UNION] THEN
    MATCH_MP_TAC TAGGED_DIVISION_UNION THEN CONJ_TAC THENL
     [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_OF_UNION_SELF], ALL_TAC] THEN
    CONJ_TAC THENL
     [ONCE_REWRITE_TAC[GSYM IMAGE_DEF] THEN
      MATCH_MP_TAC TAGGED_DIVISION_BIGUNION THEN
      FIRST_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
      SIMP_TAC std_ss [FINITE_UNION, IN_UNION] THEN ASM_MESON_TAC[],
      ALL_TAC] THEN
    MATCH_MP_TAC INTER_INTERIOR_BIGUNION_INTERVALS THEN
    REWRITE_TAC[OPEN_INTERIOR] THEN
    REPEAT(CONJ_TAC THENL
            [ASM_MESON_TAC[division_of, FINITE_UNION, IN_UNION], ALL_TAC]) THEN
    X_GEN_TAC ``k:real->bool`` THEN DISCH_TAC THEN
    ONCE_REWRITE_TAC[INTER_COMM] THEN
    MATCH_MP_TAC INTER_INTERIOR_BIGUNION_INTERVALS THEN
    SIMP_TAC std_ss [FORALL_IN_IMAGE, FORALL_PROD, OPEN_INTERIOR] THEN
    REPEAT(CONJ_TAC THENL
     [ASM_MESON_TAC[tagged_partial_division_of, IMAGE_FINITE], ALL_TAC]) THEN
    REPEAT STRIP_TAC THEN
    UNDISCH_TAC ``IMAGE (SND :real # (real -> bool) -> real -> bool)
            (p :real # (real -> bool) -> bool) UNION
          (r :(real -> bool) -> bool) division_of
          interval [((a :real),(b :real))]`` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
    DISCH_THEN (MATCH_MP_TAC) THEN
    UNDISCH_TAC `` IMAGE (SND :real # (real -> bool) -> real -> bool)
            (p :real # (real -> bool) -> bool) INTER
          (r :(real -> bool) -> bool) =
          ({} :(real -> bool) -> bool)`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [EXTENSION]) THEN
    REWRITE_TAC [NOT_IN_EMPTY, GSYM NOT_EXISTS_THM] THEN
    REWRITE_TAC [METIS [NOT_EXISTS_THM] ``(!x. x NOTIN s) = ~(?x. x IN s)``] THEN
    ASM_SIMP_TAC std_ss [EXISTS_PROD, IN_IMAGE, IN_INTER, IN_UNION] THEN
    ASM_MESON_TAC[],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  SUBGOAL_THEN
   ``sum (p UNION BIGUNION {q i | i IN r}) (\(x,k). content k * f x) =
     sum p (\(x:real,k:real->bool). content k * f x:real) +
     sum (BIGUNION {q i | (i:real->bool) IN r}) (\(x,k). content k * f x)``
  SUBST1_TAC THENL
   [MATCH_MP_TAC SUM_UNION_NONZERO THEN ASM_SIMP_TAC std_ss [] THEN
    ONCE_REWRITE_TAC[GSYM IMAGE_DEF] THEN
    ASM_SIMP_TAC std_ss [FINITE_BIGUNION_EQ, IMAGE_FINITE, FORALL_IN_IMAGE] THEN
    CONJ_TAC THENL [METIS_TAC [TAGGED_DIVISION_OF_FINITE], ALL_TAC] THEN
    REWRITE_TAC[IN_INTER] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
    SIMP_TAC std_ss [IMP_CONJ, FORALL_IN_BIGUNION, FORALL_IN_IMAGE] THEN
    SIMP_TAC std_ss [FORALL_PROD, FORALL_IN_IMAGE, RIGHT_FORALL_IMP_THM] THEN
    X_GEN_TAC ``k:real->bool`` THEN DISCH_TAC THEN
    MAP_EVERY X_GEN_TAC [``x:real``, ``l:real->bool``] THEN
    DISCH_TAC THEN
    SUBGOAL_THEN ``(l:real->bool) SUBSET k`` ASSUME_TAC THENL
     [ASM_MESON_TAC[TAGGED_DIVISION_OF], ALL_TAC] THEN DISCH_TAC THEN
    UNDISCH_TAC ``IMAGE (SND :real # (real -> bool) -> real -> bool)
            (p :real # (real -> bool) -> bool) UNION
          (r :(real -> bool) -> bool) division_of
          interval [((a :real),(b :real))]`` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
    DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
    DISCH_THEN(MP_TAC o SPECL [``k:real->bool``, ``l:real->bool``]) THEN
    KNOW_TAC ``(k :real -> bool) IN
     IMAGE (SND :real # (real -> bool) -> real -> bool)
       (p :real # (real -> bool) -> bool) UNION
     (r :(real -> bool) -> bool) /\
     (l :real -> bool) IN
     IMAGE (SND :real # (real -> bool) -> real -> bool) p UNION r /\
     k <> l`` THENL
     [ASM_SIMP_TAC std_ss [IN_UNION, IN_IMAGE, EXISTS_PROD] THEN
      CONJ_TAC THENL [ASM_MESON_TAC[], ALL_TAC] THEN
      DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
      UNDISCH_TAC `` IMAGE (SND :real # (real -> bool) -> real -> bool)
            (p :real # (real -> bool) -> bool) INTER
          (r :(real -> bool) -> bool) =
          ({} :(real -> bool) -> bool)`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [EXTENSION]) THEN
      REWRITE_TAC[NOT_IN_EMPTY, GSYM NOT_EXISTS_THM] THEN
      REWRITE_TAC [METIS [NOT_EXISTS_THM] ``(~!x. x NOTIN s) = (?x. x IN s)``] THEN
      ASM_SIMP_TAC std_ss [EXISTS_PROD, IN_IMAGE, IN_INTER, IN_UNION] THEN
      ASM_MESON_TAC[],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    ASM_SIMP_TAC std_ss [SUBSET_INTERIOR,
     SET_RULE ``s SUBSET t ==> (t INTER s = s)``] THEN
    SUBGOAL_THEN ``?u v:real. l = interval[u,v]``
     (fn th => REPEAT_TCL CHOOSE_THEN SUBST1_TAC th THEN
                SIMP_TAC std_ss [REAL_MUL_LZERO, GSYM CONTENT_EQ_0_INTERIOR]) THEN
    ASM_MESON_TAC[tagged_partial_division_of],
    ALL_TAC] THEN
  W(MP_TAC o PART_MATCH (lhand o rand) SUM_BIGUNION_NONZERO o
    rand o lhand o rand o lhand o lhand o snd) THEN
  KNOW_TAC ``FINITE
       {(q :(real -> bool) -> real # (real -> bool) -> bool) i |
        i IN (r :(real -> bool) -> bool)} /\
     (!(t :real # (real -> bool) -> bool).
        t IN {q i | i IN r} ==> FINITE t) /\
     (!(t1 :real # (real -> bool) -> bool)
         (t2 :real # (real -> bool) -> bool) (x :real # (real -> bool)).
        t1 IN {q i | i IN r} /\ t2 IN {q i | i IN r} /\ t1 <> t2 /\
        x IN t1 /\ x IN t2 ==>
        ((\((x :real),(k :real -> bool)). content k * (f :real -> real) x)
           x = (0 : real)))`` THENL
   [ONCE_REWRITE_TAC[GSYM IMAGE_DEF] THEN ASM_SIMP_TAC std_ss [IMAGE_FINITE] THEN
    SIMP_TAC std_ss [IMP_CONJ, FORALL_IN_IMAGE, RIGHT_FORALL_IMP_THM] THEN
    CONJ_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF, IN_UNION], ALL_TAC] THEN
    X_GEN_TAC ``k:real->bool`` THEN DISCH_TAC THEN
    X_GEN_TAC ``l:real->bool`` THEN DISCH_TAC THEN
    DISCH_TAC THEN SIMP_TAC std_ss [FORALL_PROD] THEN
    MAP_EVERY X_GEN_TAC [``x:real``, ``m:real->bool``] THEN
    DISCH_TAC THEN DISCH_TAC THEN
    REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN
    SUBGOAL_THEN ``?u v:real. m = interval[u,v]``
     (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC)
    THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF, IN_UNION], ALL_TAC] THEN
    REWRITE_TAC[CONTENT_EQ_0_INTERIOR] THEN
    MATCH_MP_TAC(SET_RULE ``!t. s SUBSET t /\ (t = {}) ==> (s = {})``) THEN
    EXISTS_TAC ``interior(k INTER l:real->bool)`` THEN CONJ_TAC THENL
     [MATCH_MP_TAC SUBSET_INTERIOR THEN REWRITE_TAC[SUBSET_INTER] THEN
      ASM_MESON_TAC[TAGGED_DIVISION_OF],
      ALL_TAC] THEN
    UNDISCH_TAC `` IMAGE (SND :real # (real -> bool) -> real -> bool)
            (p :real # (real -> bool) -> bool) UNION
          (r :(real -> bool) -> bool) division_of
          interval [((a :real),(b :real))]`` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
    REWRITE_TAC[INTERIOR_INTER] THEN
    DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
    DISCH_THEN(MATCH_MP_TAC o SPECL [``k:real->bool``, ``l:real->bool``]) THEN
    SIMP_TAC std_ss [IN_IMAGE, EXISTS_PROD, IN_UNION] THEN ASM_MESON_TAC[],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  DISCH_THEN SUBST1_TAC THEN ONCE_REWRITE_TAC[GSYM IMAGE_DEF] THEN
  W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_NONZERO o
    rand o lhand o rand o lhand o lhand o snd) THEN
  ASM_SIMP_TAC std_ss [o_DEF] THEN
  KNOW_TAC ``(!(x :real -> bool) (y :real -> bool).
        x IN (r :(real -> bool) -> bool) /\ y IN r /\ x <> y /\
        ((q :(real -> bool) -> real # (real -> bool) -> bool) x = q y) ==>
        (sum (q y)
           (\((x :real),(k :real -> bool)).
              content k * (f :real -> real) x) = (0 : real)))`` THENL
   [MAP_EVERY X_GEN_TAC [``k:real->bool``, ``l:real->bool``] THEN
    STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_0 THEN
    SIMP_TAC std_ss [FORALL_PROD] THEN
    MAP_EVERY X_GEN_TAC [``x:real``, ``m:real->bool``] THEN DISCH_TAC THEN
    MP_TAC(ASSUME ``!i:real->bool. i IN r ==> q i tagged_division_of i``) THEN
    DISCH_TAC THEN FIRST_ASSUM (MP_TAC o SPEC ``l:real->bool``) THEN
    FIRST_ASSUM (MP_TAC o SPEC ``k:real->bool``) THEN POP_ASSUM K_TAC THEN
    REWRITE_TAC[tagged_division_of] THEN ASM_REWRITE_TAC [] THEN METIS_TAC[],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  DISCH_THEN SUBST1_TAC THEN
  SUBGOAL_THEN
   ``sum p (\(x,k). content k * (f:real->real) x - integral k f) =
     sum p (\(x,k). content k * f x) - sum p (\(x,k). integral k f)``
  SUBST1_TAC THENL [ASM_SIMP_TAC std_ss [GSYM SUM_SUB, LAMBDA_PROD], ALL_TAC] THEN
  MATCH_MP_TAC(REAL_ARITH
   ``!ir:real. (ip + ir = i) /\
         abs(cr - ir) < k
         ==> abs((cp + cr) - i) < e ==> abs(cp - ip) <= e + k``) THEN
  EXISTS_TAC ``sum r (\k. integral k (f:real->real))`` THEN CONJ_TAC THENL
   [MATCH_MP_TAC EQ_TRANS THEN
    EXISTS_TAC ``sum (IMAGE SND (p:(real#(real->bool))->bool) UNION r)
                     (\k. integral k (f:real->real))`` THEN
    CONJ_TAC THENL
     [ALL_TAC, METIS_TAC[INTEGRAL_COMBINE_DIVISION_TOPDOWN]] THEN
    MATCH_MP_TAC EQ_TRANS THEN
    EXISTS_TAC ``sum (IMAGE SND (p:(real#(real->bool))->bool))
                     (\k. integral k (f:real->real)) +
                 sum r (\k. integral k f)`` THEN
    CONJ_TAC THENL
     [ALL_TAC,
      CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNION_NONZERO THEN
      ASM_SIMP_TAC std_ss [IMAGE_FINITE, NOT_IN_EMPTY]] THEN
    AP_THM_TAC THEN AP_TERM_TAC THEN
    SUBGOAL_THEN ``(\(x:real,k). integral k (f:real->real)) =
                   (\k. integral k f) o SND``
    SUBST1_TAC THENL
     [SIMP_TAC std_ss [o_THM, FUN_EQ_THM, FORALL_PROD], ALL_TAC] THEN
    CONV_TAC SYM_CONV THEN REWRITE_TAC [REAL_EQ_RADD] THEN
    MATCH_MP_TAC SUM_IMAGE_NONZERO THEN
    ASM_SIMP_TAC std_ss [FORALL_PROD] THEN
    MAP_EVERY X_GEN_TAC
     [``x:real``, ``l:real->bool``, ``y:real``] THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    DISCH_TAC THEN
    UNDISCH_TAC ``p tagged_partial_division_of interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o
      REWRITE_RULE [tagged_partial_division_of]) THEN
    DISCH_THEN(CONJUNCTS_THEN MP_TAC o CONJUNCT2) THEN
    DISCH_THEN(MP_TAC o SPECL
     [``x:real``, ``l:real->bool``, ``y:real``, ``l:real->bool``]) THEN
    ASM_REWRITE_TAC[INTER_IDEMPOT] THEN DISCH_TAC THEN
    DISCH_THEN(MP_TAC o SPECL [``x:real``, ``l:real->bool``]) THEN
    ASM_REWRITE_TAC[] THEN
    DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC o last o CONJUNCTS) THEN
    MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_NULL THEN
    ASM_SIMP_TAC std_ss [CONTENT_EQ_0_INTERIOR],
    ALL_TAC] THEN
  ASM_SIMP_TAC std_ss [GSYM SUM_SUB] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
  EXISTS_TAC ``sum (r:(real->bool)->bool) (\x. k / (&(CARD r) + &1))`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC SUM_ABS_LE THEN ASM_SIMP_TAC std_ss [REAL_LT_IMP_LE],
    ASM_SIMP_TAC std_ss [SUM_CONST] THEN
    REWRITE_TAC[real_div, REAL_MUL_ASSOC] THEN
    SIMP_TAC std_ss [GSYM real_div, REAL_LT_LDIV_EQ,
     METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0]
    ``&0 < &n + &1:real``] THEN
    REWRITE_TAC[REAL_ARITH ``a * k < k * b <=> &0 < k * (b - a:real)``] THEN
    MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);

val ABS_LE_L1 = store_thm ("ABS_LE_L1",
 ``!x:real. abs x <= sum((1:num)..(1:num)) (\i. abs(x))``,
  REWRITE_TAC [NUMSEG_SING, SUM_SING, REAL_LE_REFL]);

val SUM_ABS_ALLSUBSETS_BOUND = store_thm ("SUM_ABS_ALLSUBSETS_BOUND",
 ``!f:'a->real p e.
        FINITE p /\
        (!q. q SUBSET p ==> abs(sum q f) <= e)
        ==> sum p (\x. abs(f x)) <= &2 * &(1:num):real * e``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC
   ``sum p (\x:'a. sum ((1:num)..(1:num)) ((\x i. abs((f x:real))) x))`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC std_ss [ABS_LE_L1], ALL_TAC] THEN
  W(MP_TAC o PART_MATCH (lhand o rand) SUM_SWAP o lhand o snd) THEN
  ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN
  ONCE_REWRITE_TAC[REAL_ARITH ``&2 * &n * e = &n * &2 * e:real``] THEN
  BETA_TAC THEN
  GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV)
   [METIS [GSYM CARD_NUMSEG_1] ``1:real = &CARD ((1:num)..(1:num))``] THEN
  REWRITE_TAC [GSYM REAL_MUL_ASSOC] THEN
  MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG, IN_NUMSEG] THEN
  X_GEN_TAC ``k:num`` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC ``sum {x:'a | x IN p /\ &0 <= (f x:real)} (\x. abs((f x))) +
               sum {x | x IN p /\ (f x) < &0} (\x. abs((f x)))`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC(REAL_ARITH ``(a = b) ==> b <= a:real``) THEN
    MATCH_MP_TAC SUM_UNION_EQ THEN
    ASM_SIMP_TAC std_ss [EXTENSION, NOT_IN_EMPTY, IN_INTER,
                         IN_UNION, GSPECIFICATION] THEN
    CONJ_TAC THEN X_GEN_TAC ``x:'a`` THEN ASM_CASES_TAC ``(x:'a) IN p`` THEN
    ASM_SIMP_TAC std_ss [] THEN REAL_ARITH_TAC,
    ALL_TAC] THEN
  MATCH_MP_TAC(REAL_ARITH ``x <= e /\ y <= e ==> x + y <= &2 * e:real``) THEN
  GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM ABS_NEG] THEN
  CONJ_TAC THEN MATCH_MP_TAC(REAL_ARITH
   ``!g. (sum s g = sum s f) /\ sum s g <= e ==> sum s f <= e:real``)
  THENL
   [EXISTS_TAC ``\x. ((f:'a->real) x)``,
    EXISTS_TAC ``\x. -(((f:'a->real) x))``] THEN
  (CONJ_TAC THENL
    [MATCH_MP_TAC SUM_EQ THEN SIMP_TAC std_ss [GSPECIFICATION] THEN REAL_ARITH_TAC,
     ALL_TAC]) THEN
  ASM_SIMP_TAC std_ss [SUM_NEG, FINITE_RESTRICT] THEN
  MATCH_MP_TAC(REAL_ARITH ``abs(x) <= e ==> x <= e:real``) THEN
  SIMP_TAC std_ss [ABS_NEG, ETA_AX] THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN SET_TAC[]);

val HENSTOCK_LEMMA_PART2 = store_thm ("HENSTOCK_LEMMA_PART2",
 ``!f:real->real a b d e.
        f integrable_on interval[a,b] /\
        &0 < e /\ gauge d /\
        (!p. p tagged_division_of interval[a,b] /\ d FINE p
             ==> abs (sum p (\(x,k). content k * f x) -
                       integral(interval[a,b]) f) < e)
        ==> !p. p tagged_partial_division_of interval[a,b] /\ d FINE p
                            ==> sum p (\(x,k). abs(content k * f x -
                                                    integral k f))
                                <= &2 * &(1:num):real * e``,
  REPEAT STRIP_TAC THEN SIMP_TAC std_ss [LAMBDA_PAIR] THEN
  ONCE_REWRITE_TAC [METIS []
   ``(content (SND p) * f (FST p) - integral (SND p) f) =
     (\p. (content (SND p) * f (FST p) - integral (SND p) f)) p``] THEN
  MATCH_MP_TAC SUM_ABS_ALLSUBSETS_BOUND THEN
  SIMP_TAC std_ss [LAMBDA_PROD] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[tagged_partial_division_of], ALL_TAC] THEN
  X_GEN_TAC ``q:(real#(real->bool))->bool`` THEN DISCH_TAC THEN
  MATCH_MP_TAC(SIMP_RULE std_ss [RIGHT_IMP_FORALL_THM, AND_IMP_INTRO]
    HENSTOCK_LEMMA_PART1) THEN
  MAP_EVERY EXISTS_TAC
   [``a:real``, ``b:real``, ``d:real->real->bool``] THEN
  ASM_SIMP_TAC std_ss [] THEN
  ASM_MESON_TAC[FINE_SUBSET, TAGGED_PARTIAL_DIVISION_SUBSET]);

val HENSTOCK_LEMMA = store_thm ("HENSTOCK_LEMMA",
 ``!f:real->real a b.
        f integrable_on interval[a,b]
        ==> !e. &0 < e
                ==> ?d. gauge d /\
                        !p. p tagged_partial_division_of interval[a,b] /\
                            d FINE p
                            ==> sum p (\(x,k). abs(content k * f x -
                                                    integral k f)) < e``,
  MP_TAC HENSTOCK_LEMMA_PART2 THEN
  DISCH_TAC THEN REPEAT GEN_TAC THEN
  POP_ASSUM (MP_TAC o Q.SPECL [`(f :real -> real)`, `(a :real)`, `(b :real)`]) THEN
  DISCH_THEN(fn th => STRIP_TAC THEN X_GEN_TAC ``e:real`` THEN
                       STRIP_TAC THEN MP_TAC th) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN
  GEN_REWR_TAC LAND_CONV [has_integral] THEN
  DISCH_THEN(MP_TAC o SPEC ``e / (&2 * (&(1:num) + &1:real))``) THEN
  ASM_SIMP_TAC std_ss [REAL_LT_DIV, REAL_ARITH ``&0 < &2 * (&1 + &1:real)``] THEN
  DISCH_THEN(X_CHOOSE_THEN ``d:real->real->bool`` STRIP_ASSUME_TAC) THEN
  DISCH_THEN(MP_TAC o SPECL
   [``d:real->real->bool``, ``e / (&2 * (&(1:num) + &1:real))``]) THEN
  ASM_SIMP_TAC std_ss [REAL_LT_DIV, REAL_ARITH ``&0 < &2 * (&1 + &1:real)``] THEN
  DISCH_THEN(fn th => EXISTS_TAC ``d:real->real->bool`` THEN MP_TAC th) THEN
  ASM_SIMP_TAC std_ss [] THEN DISCH_TAC THEN GEN_TAC THEN
  POP_ASSUM (MP_TAC o Q.SPEC `(p :real # (real -> bool) -> bool)`) THEN
  MATCH_MP_TAC MONO_IMP THEN SIMP_TAC std_ss [] THEN
  MATCH_MP_TAC(REAL_ARITH ``d < e ==> x <= d ==> x < e:real``) THEN
  SIMP_TAC std_ss [real_div, REAL_INV_MUL, REAL_INV_INV, REAL_MUL_ASSOC] THEN
  SIMP_TAC std_ss [GSYM real_div, REAL_LT_LDIV_EQ,
   METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0]  ``&0 < &n + &1:real``] THEN
  SIMP_TAC std_ss [REAL_LT_LDIV_EQ, REAL_ARITH ``0:real < (2 * (1 + 1))``] THEN
  UNDISCH_TAC ``&0 < e:real`` THEN REAL_ARITH_TAC);

(* ------------------------------------------------------------------------- *)
(* Monotone convergence (bounded interval first).                            *)
(* ------------------------------------------------------------------------- *)

val lemma = prove (
  ``{(x,y) | P x y} = {p | P (FST p) (SND p)}``,
  SIMP_TAC std_ss [EXTENSION, FORALL_PROD, IN_ELIM_PAIR_THM, GSPECIFICATION]);

val MONOTONE_CONVERGENCE_INTERVAL = store_thm ("MONOTONE_CONVERGENCE_INTERVAL",
 ``!f:num->real->real g a b.
        (!k. (f k) integrable_on interval[a,b]) /\
        (!k x. x IN interval[a,b] ==> (f k x) <= (f (SUC k) x)) /\
        (!x. x IN interval[a,b] ==> ((\k. f k x) --> g x) sequentially) /\
        bounded {integral (interval[a,b]) (f k) | k IN univ(:num)}
        ==> g integrable_on interval[a,b] /\
            ((\k. integral (interval[a,b]) (f k))
             --> integral (interval[a,b]) g) sequentially``,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  ASM_CASES_TAC ``content(interval[a:real,b]) = &0`` THENL
   [ASM_SIMP_TAC std_ss [INTEGRAL_NULL, INTEGRABLE_ON_NULL, LIM_CONST],
    RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONTENT_LT_NZ])] THEN
  SUBGOAL_THEN
   ``!x:real k:num. x IN interval[a,b] ==> (f k x) <= (g x):real``
  ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN
    MATCH_MP_TAC(ISPEC ``sequentially`` LIM_DROP_LBOUND) THEN
    EXISTS_TAC ``\k. (f:num->real->real) k x`` THEN
    ASM_SIMP_TAC std_ss [TRIVIAL_LIMIT_SEQUENTIALLY, EVENTUALLY_SEQUENTIALLY] THEN
    EXISTS_TAC ``k:num`` THEN SPEC_TAC(``k:num``,``k:num``) THEN
    ONCE_REWRITE_TAC [METIS []
     ``!k x'. ((f:num->real->real) k x <= f x' x) =
          (\k x'. f k x <= f x' x) k x'``] THEN
    MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN SIMP_TAC std_ss [REAL_LE_TRANS] THEN
    ASM_SIMP_TAC std_ss [REAL_LE_REFL] THEN METIS_TAC [REAL_LE_TRANS],
    ALL_TAC] THEN
  SUBGOAL_THEN
   ``?i. ((\k. integral (interval[a,b]) (f k:real->real)) --> i)
        sequentially``
  CHOOSE_TAC THENL
   [MATCH_MP_TAC BOUNDED_INCREASING_CONVERGENT THEN ASM_SIMP_TAC std_ss [] THEN
    GEN_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[],
    ALL_TAC] THEN
  SUBGOAL_THEN
   ``!k. (integral(interval[a,b]) ((f:num->real->real) k)) <= i``
  ASSUME_TAC THENL
    [GEN_TAC THEN MATCH_MP_TAC(ISPEC ``sequentially`` LIM_DROP_LBOUND) THEN
     EXISTS_TAC ``\k. integral(interval[a,b]) ((f:num->real->real) k)`` THEN
     ASM_SIMP_TAC std_ss [TRIVIAL_LIMIT_SEQUENTIALLY, EVENTUALLY_SEQUENTIALLY] THEN
     EXISTS_TAC ``k:num`` THEN SPEC_TAC(``k:num``,``k:num``) THEN
     ONCE_REWRITE_TAC [METIS []
      ``(integral (interval [(a,b)]) (f k) <= integral (interval [(a,b)]) (f x)) =
       (\k x. integral (interval [(a,b)]) (f k) <=
                  integral (interval [(a,b)]) (f x)) k x``] THEN
     MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
     ASM_SIMP_TAC std_ss [REAL_LE_REFL, REAL_LE_TRANS] THEN
     CONJ_TAC THENL [METIS_TAC [REAL_LE_TRANS], ALL_TAC] THEN
     GEN_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[],
     ALL_TAC] THEN
  SUBGOAL_THEN
   ``((g:real->real) has_integral i) (interval[a,b])``
  ASSUME_TAC THENL
   [REWRITE_TAC[has_integral] THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
    UNDISCH_TAC ``!k:num. f k integrable_on interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o REWRITE_RULE [HAS_INTEGRAL_INTEGRAL]) THEN
    REWRITE_TAC[has_integral] THEN
    DISCH_THEN(MP_TAC o GEN ``k:num`` o
      SPECL [``k:num``, ``e / (&2:real) pow (k + 2)``]) THEN
    ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_POW_LT, REAL_LT] THEN
    DISCH_TAC THEN POP_ASSUM (MP_TAC o SIMP_RULE std_ss [SKOLEM_THM]) THEN
    SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM, FORALL_AND_THM] THEN
    X_GEN_TAC ``b:num->real->real->bool`` THEN STRIP_TAC THEN
    SUBGOAL_THEN
     ``?r. !k. r:num <= k
               ==> &0 <= i - (integral(interval[a:real,b]) (f k)) /\
                   i - (integral(interval[a,b]) (f k)) < e / &4``
    STRIP_ASSUME_TAC THENL
     [UNDISCH_TAC `` ((\k. integral (interval [(a,b)]) (f k)) --> i) sequentially`` THEN
      DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [LIM_SEQUENTIALLY]) THEN
      DISCH_THEN(MP_TAC o SPEC ``e / &4:real``) THEN
      ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT] THEN
      DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
      X_GEN_TAC ``n:num`` THEN POP_ASSUM (MP_TAC o Q.SPEC `n:num`) THEN
      MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[dist] THEN
      MATCH_MP_TAC(REAL_ARITH
       ``x <= y ==> abs(x - y) < e ==> &0 <= y - x /\ y - x < e:real``) THEN
      ASM_REWRITE_TAC[],
      ALL_TAC] THEN
    SUBGOAL_THEN
     ``!x. x IN interval[a:real,b]
          ==> ?n. r:num <= n /\
                  !k. n <= k ==> &0 <= (g x) - (f k x) /\
                                 (g x) - (f k x) <
                                   e / (&4 * content(interval[a,b]))``
    MP_TAC THENL
     [X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
      UNDISCH_TAC ``!x. x IN interval [(a,b)] ==>
                        ((\k. f k x) --> g x) sequentially`` THEN
      DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[LIM_SEQUENTIALLY]) THEN
      DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN ASM_SIMP_TAC std_ss [REAL_SUB_LE] THEN
      DISCH_THEN(MP_TAC o SPEC ``e / (&4 * content(interval[a:real,b]))``) THEN
      ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_LT_MUL, REAL_LT] THEN
      REWRITE_TAC[dist] THEN
      ASM_SIMP_TAC std_ss [REAL_ARITH ``f <= g ==> (abs(f - g) = g - f:real)``] THEN
      DISCH_THEN(X_CHOOSE_TAC ``N:num``) THEN
      EXISTS_TAC ``N + r:num`` THEN CONJ_TAC THENL [ARITH_TAC, ALL_TAC] THEN
      ASM_MESON_TAC[ARITH_PROVE ``N + r:num <= k ==> N <= k``],
      ALL_TAC] THEN
    DISCH_TAC THEN POP_ASSUM (MP_TAC o SIMP_RULE std_ss [RIGHT_IMP_EXISTS_THM]) THEN
    SIMP_TAC std_ss [SKOLEM_THM] THEN
    SIMP_TAC std_ss [FORALL_AND_THM, TAUT
     `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN
    SIMP_TAC std_ss [RIGHT_IMP_FORALL_THM, AND_IMP_INTRO] THEN
    DISCH_THEN(X_CHOOSE_THEN ``m:real->num`` STRIP_ASSUME_TAC) THEN
    ABBREV_TAC ``d:real->real->bool = \x. b(m x:num) x`` THEN
    EXISTS_TAC ``d:real->real->bool`` THEN CONJ_TAC THENL
     [EXPAND_TAC "d" THEN REWRITE_TAC[gauge_def] THEN
      UNDISCH_TAC ``!k:num. gauge (b k)`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [gauge_def]) THEN
      SIMP_TAC std_ss [],
      ALL_TAC] THEN
    X_GEN_TAC ``p:(real#(real->bool))->bool`` THEN STRIP_TAC THEN
    GEN_REWR_TAC (RAND_CONV) [GSYM REAL_HALF] THEN
    GEN_REWR_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_HALF] THEN
    REWRITE_TAC [METIS [real_div, GSYM REAL_INV_MUL, REAL_ARITH ``0 <> 2:real``,
     REAL_ARITH ``2 * 2 = 4:real``, GSYM REAL_MUL_ASSOC]
           ``e / 2 / 2 = e / 4:real``] THEN
    MATCH_MP_TAC(REAL_ARITH
     ``!b c. abs(a - b) <= e / &4 /\
            abs(b - c) < e / &2 /\
            abs(c - d) < e / &4
            ==> abs(a - d) < e:real / 2 + (e / 4 + e / 4)``) THEN
    EXISTS_TAC ``sum p (\(x:real,k:real->bool).
                  content k * (f:num->real->real) (m x) x)`` THEN
    EXISTS_TAC ``sum p (\(x:real,k:real->bool).
                  integral k ((f:num->real->real) (m x)))`` THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
    SUBGOAL_THEN ``?s:num. !t:real#(real->bool). t IN p ==> m(FST t) <= s``
    MP_TAC THENL [ASM_SIMP_TAC std_ss [UPPER_BOUND_FINITE_SET], ALL_TAC] THEN
    SIMP_TAC std_ss [FORALL_PROD] THEN DISCH_THEN(X_CHOOSE_TAC ``s:num``) THEN
    REPEAT CONJ_TAC THENL
     [ASM_SIMP_TAC std_ss [GSYM SUM_SUB] THEN SIMP_TAC std_ss [LAMBDA_PROD] THEN
      SIMP_TAC std_ss [GSYM REAL_SUB_LDISTRIB] THEN
      W(MP_TAC o PART_MATCH (lhand o rand) SUM_ABS o lhand o snd) THEN
      ASM_SIMP_TAC std_ss [] THEN
      MATCH_MP_TAC(REAL_ARITH ``y <= e ==> x <= y ==> x <= e:real``) THEN
      SIMP_TAC std_ss [LAMBDA_PROD] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
      EXISTS_TAC
       ``sum p (\(x:real,k:real->bool).
                 content k * e / (&4 * content (interval[a:real,b])))`` THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC std_ss [FORALL_PROD] THEN
        MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN
        DISCH_TAC THEN SIMP_TAC std_ss [ABS_MUL, GSYM REAL_SUB_LDISTRIB] THEN
        REWRITE_TAC [real_div, GSYM REAL_MUL_ASSOC] THEN
                REWRITE_TAC [GSYM real_div] THEN
        MATCH_MP_TAC REAL_LE_MUL2 THEN
        SIMP_TAC std_ss [REAL_ABS_POS, ABS_POS] THEN
        REWRITE_TAC[REAL_ARITH ``abs(x) <= x <=> &0 <= x:real``] THEN CONJ_TAC THENL
         [ASM_MESON_TAC[CONTENT_POS_LE, TAGGED_DIVISION_OF], ALL_TAC] THEN
        MATCH_MP_TAC(REAL_ARITH
         ``&0 <= g - f /\ g - f < e ==> abs(g - f) <= e:real``) THEN
        CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
        REWRITE_TAC[LESS_EQ_REFL] THEN ASM_MESON_TAC[TAGGED_DIVISION_OF, SUBSET_DEF],
        ALL_TAC] THEN
      SIMP_TAC std_ss [LAMBDA_PAIR] THEN
      ONCE_REWRITE_TAC [METIS [] ``content (SND p) = (\p. content (SND p)) p``] THEN
      REWRITE_TAC [real_div, GSYM REAL_MUL_ASSOC] THEN
          REWRITE_TAC [GSYM real_div] THEN
      REWRITE_TAC [SUM_RMUL] THEN SIMP_TAC std_ss [LAMBDA_PROD] THEN
      UNDISCH_TAC ``p tagged_division_of interval [(a,b)]`` THEN DISCH_TAC THEN
      FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP
       ADDITIVE_CONTENT_TAGGED_DIVISION th]) THEN
      MATCH_MP_TAC REAL_EQ_IMP_LE THEN
      UNDISCH_TAC ``&0 < content(interval[a:real,b])`` THEN
      REWRITE_TAC [real_div, REAL_MUL_ASSOC] THEN
      SIMP_TAC std_ss [REAL_LT_IMP_NE, REAL_INV_MUL, REAL_ARITH ``4 <> 0:real``] THEN
      REWRITE_TAC [REAL_MUL_ASSOC] THEN
      ONCE_REWRITE_TAC [REAL_ARITH ``a * b * c * d = (a * d) * b * c:real``] THEN
      SIMP_TAC std_ss [REAL_LT_IMP_NE, REAL_MUL_RINV, REAL_MUL_LID],
      ASM_SIMP_TAC std_ss [GSYM SUM_SUB] THEN SIMP_TAC std_ss [LAMBDA_PAIR] THEN
      MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC
        ``abs(sum ((0:num)..s)
               (\j. sum {(x:real,k:real->bool) | (x,k) IN p /\ (m(x) = j)}
                         (\(x,k). content k * f (m x) x :real -
                                  integral k (f (m x)))))`` THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC REAL_EQ_IMP_LE THEN SIMP_TAC std_ss [lemma] THEN
        AP_TERM_TAC THEN SIMP_TAC std_ss [LAMBDA_PAIR] THEN
        REWRITE_TAC [SET_RULE ``{p' | p' IN p /\ (m (FST p') = j)} =
                       {p' | p' IN p /\ ((\p'. m (FST p')) p' = j)}``] THEN
        MATCH_MP_TAC(GSYM SUM_GROUP) THEN
        ASM_SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_IMAGE, IN_NUMSEG, LE_0] THEN
        ASM_SIMP_TAC std_ss [FORALL_PROD] THEN METIS_TAC [],
        ALL_TAC] THEN
      MATCH_MP_TAC REAL_LET_TRANS THEN
      EXISTS_TAC ``sum ((0:num)..s) (\i. e / &2 pow (i + 2))`` THEN CONJ_TAC THENL
       [ALL_TAC,
        SIMP_TAC std_ss [real_div, GSYM REAL_POW_INV, SUM_LMUL] THEN
        SIMP_TAC std_ss [REAL_POW_ADD, SUM_RMUL] THEN REWRITE_TAC[SUM_GP] THEN
        KNOW_TAC ``inv 2 <> 1:real`` THENL
        [SIMP_TAC std_ss [REAL_INV_1OVER, REAL_EQ_LDIV_EQ,
                 REAL_ARITH ``0 < 2:real``] THEN
         REAL_ARITH_TAC, DISCH_TAC] THEN
        ASM_SIMP_TAC std_ss [pow, REAL_LT_LMUL] THEN
        SIMP_TAC std_ss [METIS [REAL_HALF_DOUBLE,
                 REAL_EQ_SUB_RADD, REAL_INV_1OVER]
         ``1 - inv 2 = inv 2:real``] THEN
        REWRITE_TAC [real_div, REAL_INV_INV, POW_2] THEN
        ONCE_REWRITE_TAC [REAL_ARITH
                 ``a * b * (c * d) = a * (b * c) * d:real``] THEN
        REWRITE_TAC [METIS [REAL_MUL_RINV, REAL_ARITH ``2 <> 0:real``]
         ``2 * inv 2 = 1:real``] THEN
        GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
        SIMP_TAC std_ss [REAL_LT_RMUL, REAL_INV_POS,
                 REAL_ARITH ``0 < 2:real``] THEN
        REWRITE_TAC [REAL_MUL_RID, real_sub] THEN
                GEN_REWR_TAC RAND_CONV [GSYM REAL_ADD_RID] THEN
        REWRITE_TAC [REAL_LT_LADD] THEN REWRITE_TAC [GSYM pow] THEN
        ONCE_REWRITE_TAC [GSYM REAL_LT_NEG] THEN
                REWRITE_TAC [REAL_NEG_0, REAL_NEG_NEG] THEN
        MATCH_MP_TAC POW_POS_LT THEN
        SIMP_TAC std_ss [REAL_INV_1OVER, REAL_LT_RDIV_EQ,
                REAL_ARITH ``0 < 2:real``] THEN
        REAL_ARITH_TAC] THEN
      MATCH_MP_TAC SUM_ABS_LE THEN REWRITE_TAC[FINITE_NUMSEG] THEN
      X_GEN_TAC ``t:num`` THEN REWRITE_TAC[IN_NUMSEG, LE_0] THEN DISCH_TAC THEN
      MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
       ``abs(sum {x:real,k:real->bool | (x,k) IN p /\ (m x:num = t)}
                  (\(x,k). content k * f t x - integral k (f t)):real)`` THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN BETA_TAC THEN
        MATCH_MP_TAC SUM_EQ THEN SIMP_TAC std_ss [FORALL_PROD, IN_ELIM_PAIR_THM],
        ALL_TAC] THEN
      MATCH_MP_TAC(SIMP_RULE std_ss [RIGHT_IMP_FORALL_THM, AND_IMP_INTRO]
        HENSTOCK_LEMMA_PART1) THEN
      MAP_EVERY EXISTS_TAC
       [``a:real``, ``b:real``, ``(b(t:num)):real->real->bool``] THEN
      ASM_SIMP_TAC std_ss [] THEN
      ASM_SIMP_TAC arith_ss [REAL_LT_DIV, REAL_POW_LT, REAL_LT] THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC TAGGED_PARTIAL_DIVISION_SUBSET THEN
        EXISTS_TAC ``p:(real#(real->bool))->bool`` THEN
        SIMP_TAC std_ss [SUBSET_DEF, FORALL_PROD, IN_ELIM_PAIR_THM] THEN
        ASM_MESON_TAC[tagged_division_of],
        ALL_TAC] THEN
      UNDISCH_TAC
      ``(d :real -> real -> bool) FINE (p :real # (real -> bool) -> bool)`` THEN
      DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [FINE]) THEN
      EXPAND_TAC "d" THEN SIMP_TAC std_ss [FINE, IN_ELIM_PAIR_THM] THEN MESON_TAC[],
      MP_TAC(ISPECL [``(f:num->real->real) s``, ``a:real``, ``b:real``,
                     ``p:(real#(real->bool))->bool``]
                    INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN) THEN
      MP_TAC(ISPECL [``(f:num->real->real) r``, ``a:real``, ``b:real``,
                     ``p:(real#(real->bool))->bool``]
                    INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN) THEN
      ASM_SIMP_TAC std_ss  [] THEN
      SIMP_TAC std_ss [o_DEF, LAMBDA_PROD] THEN MATCH_MP_TAC(REAL_ARITH
       ``sr <= sx /\ sx <= ss /\ ks <= i /\ &0 <= i - kr /\ i - kr < e
        ==> (kr = sr) ==> (ks = ss) ==> abs(sx - i) < e:real``) THEN
      ASM_SIMP_TAC std_ss [LESS_EQ_REFL] THEN CONJ_TAC THEN MATCH_MP_TAC SUM_LE THEN
      ASM_SIMP_TAC std_ss [FORALL_PROD] THEN
      MAP_EVERY X_GEN_TAC [``x:real``, ``i:real->bool``] THEN DISCH_TAC THEN
      (SUBGOAL_THEN ``i SUBSET interval[a:real,b]`` ASSUME_TAC THENL
        [METIS_TAC[TAGGED_DIVISION_OF], ALL_TAC] THEN
       SUBGOAL_THEN ``?u v:real. i = interval[u,v]``
        (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC)
       THENL [METIS_TAC[TAGGED_DIVISION_OF], ALL_TAC]) THEN
      MATCH_MP_TAC INTEGRAL_DROP_LE THEN
      REPEAT(CONJ_TAC THENL
       [ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL], ALL_TAC]) THEN
      X_GEN_TAC ``y:real`` THEN DISCH_TAC THEN
      MP_TAC(ISPEC
        ``\m n:num. (f m (y:real)) <= (f n y):real``
        TRANSITIVE_STEPWISE_LE) THEN
      SIMP_TAC std_ss [REAL_LE_TRANS, REAL_LE_REFL] THEN
      (KNOW_TAC ``(!(x :num) (y' :num) (z :num).
        (f :num -> real -> real) x (y :real) <= f y' y /\
        f y' y <= f z y ==> f x y <= f z y)`` THENL
     [SRW_TAC [][] THEN METIS_TAC [REAL_LE_TRANS, REAL_LE_REFL],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC]) THEN
      (KNOW_TAC
          ``!(n :num). (f :num -> real -> real) n (y :real) <= f (SUC n) y`` THENL
      [METIS_TAC[SUBSET_DEF], DISCH_TAC THEN ASM_REWRITE_TAC []]) THEN
      DISCH_THEN MATCH_MP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_MESON_TAC[TAGGED_DIVISION_OF, SUBSET_DEF]],
    ALL_TAC] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[integrable_on], ALL_TAC] THEN
  FIRST_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN
  ASM_SIMP_TAC std_ss []);

Theorem MONOTONE_CONVERGENCE_INCREASING :
    !f:num->real->real g s.
        (!k. (f k) integrable_on s) /\
        (!k x. x IN s ==> (f k x) <= (f (SUC k) x)) /\
        (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) /\
        bounded {integral s (f k) | k IN univ(:num)}
        ==> g integrable_on s /\
            ((\k. integral s (f k)) --> integral s g) sequentially
Proof
  SUBGOAL_THEN
   ``!f:num->real->real g s.
        (!k x. x IN s ==> &0 <= (f k x)) /\
        (!k. (f k) integrable_on s) /\
        (!k x. x IN s ==> (f k x) <= (f (SUC k) x)) /\
        (!x. x IN s ==> ((\k. f k x) --> (g x):real) sequentially) /\
        bounded {integral s (f k) | k IN univ(:num)}
        ==> g integrable_on s /\
            ((\k. integral s (f k)) --> integral s g) sequentially``
  ASSUME_TAC THENL
  [ ALL_TAC,
    REPEAT GEN_TAC THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o ISPECL
     [``\n x:real. f(SUC n) x - f (0:num) x:real``,
      ``\x. (g:real->real) x - f (0:num) x``, ``s:real->bool``]) THEN
    SIMP_TAC std_ss [] THEN
    KNOW_TAC ``(!(k :num) (x :real).
        x IN (s :real -> bool) ==>
        (0 :real) <= (f :num -> real -> real) (SUC k) x - f (0 :num) x) /\
     (!(k :num).
        (\(x :real). f (SUC k) x - f (0 :num) x) integrable_on s) /\
     (!(k :num) (x :real).
        x IN s ==>
        f (SUC k) x - f (0 :num) x <= f (SUC (SUC k)) x - f (0 :num) x) /\
     (!(x :real).
        x IN s ==>
        (((\(k :num). f (SUC k) x - f (0 :num) x) -->
          ((g :real -> real) x - f (0 :num) x)) sequentially :bool)) /\
     (bounded
        {integral s (\(x :real). f (SUC k) x - f (0 :num) x) |
         k IN univ((:num) :num itself)} :bool)`` THEN REPEAT CONJ_TAC THENL
     [(* goal 1 (of 6) *)
      REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_SUB_LE] THEN
      MP_TAC(ISPEC
        ``\m n:num. (f m (x:real)) <= (f n x):real``
        TRANSITIVE_STEPWISE_LE) THEN
      SIMP_TAC std_ss [REAL_LE_TRANS, REAL_LE_REFL] THEN
      METIS_TAC[REAL_LE_TRANS, LE_0],
      (* goal 2 (of 6) *)
      GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_SIMP_TAC std_ss [ETA_AX],
      (* goal 3 (of 6) *)
      REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_SUB_LE] THEN
      ASM_SIMP_TAC std_ss [REAL_ARITH ``x - a <= y - a <=> x <= y:real``],
      (* goal 4 (of 6) *)
      REPEAT STRIP_TAC THEN
      ONCE_REWRITE_TAC [METIS [] ``!k. (f (SUC k) x - (f:num->real->real) 0 x) =
                               ((\k. f (SUC k) x) k - (\k. f 0 x) k)``] THEN
      MATCH_MP_TAC LIM_SUB THEN SIMP_TAC std_ss [LIM_CONST] THEN
      REWRITE_TAC[ADD1] THEN
      ONCE_REWRITE_TAC [METIS []
          ``(\k. f (k + 1) x) = (\k. (\a. f (a) x) (k + 1:num))``] THEN
      MATCH_MP_TAC(ISPECL[``f:num->real``, ``l:real``, ``1:num``] SEQ_OFFSET) THEN
      ASM_SIMP_TAC std_ss [],
      (* goal 5 (of 6) *)
      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [bounded_def]) THEN
      SIMP_TAC std_ss [bounded_def] THEN
      ONCE_REWRITE_TAC [METIS []
      ``(\x:real. f (SUC k) x - (f 0 x):real) =
            (\x. (\x. f (SUC k) x) x - (\x. f 0 x) x)``] THEN
      UNDISCH_TAC ``!k. (f:num->real->real) k integrable_on s`` THEN DISCH_TAC THEN
      FIRST_ASSUM (MP_TAC o ONCE_REWRITE_RULE [METIS []
       ``!k. (f:num->real->real) k = (\x. f k x)``]) THEN DISCH_TAC THEN
      ASM_SIMP_TAC std_ss [INTEGRAL_SUB, ETA_AX, METIS []
       ``!k. (\x. f k x) = f k``] THEN
      ONCE_REWRITE_TAC [METIS []
          ``(integral s (f (SUC k)) - integral s ((f:num->real->real) 0)) =
        (\k. integral s (f (SUC k)) - integral s (f 0)) k``] THEN
      ONCE_REWRITE_TAC [METIS []
          ``integral s (f k) = (\k. integral s (f k)) k``] THEN
      ONCE_REWRITE_TAC [GSYM IMAGE_DEF] THEN BETA_TAC THEN
      SIMP_TAC std_ss [FORALL_IN_IMAGE, IN_UNIV] THEN
      DISCH_THEN(X_CHOOSE_THEN ``B:real``
        (fn th => EXISTS_TAC ``(B:real) + abs(integral s (f (0:num):real->real))`` THEN
                   X_GEN_TAC ``k:num`` THEN MP_TAC(SPEC ``SUC k`` th))) THEN
      REAL_ARITH_TAC,
      (* goal 6 (of 6) *)
      ASM_SIMP_TAC std_ss [] THEN DISCH_TAC THEN POP_ASSUM K_TAC THEN
      ONCE_REWRITE_TAC [METIS []
      ``(\x:real. f (SUC k) x - (f 0 x):real) =
            (\x. (\x. f (SUC k) x) x - (\x. f 0 x) x)``] THEN
      UNDISCH_TAC ``!k. (f:num->real->real) k integrable_on s`` THEN DISCH_TAC THEN
      FIRST_ASSUM (MP_TAC o ONCE_REWRITE_RULE [METIS []
       ``!k. (f:num->real->real) k = (\x. f k x)``]) THEN DISCH_TAC THEN
      ASM_SIMP_TAC std_ss [INTEGRAL_SUB, ETA_AX, METIS []
       ``!k. (\x. f k x) = f k``] THEN ASM_SIMP_TAC std_ss [IMP_CONJ] THEN
      SUBGOAL_THEN ``(f (0:num):real->real) integrable_on s`` MP_TAC THENL
       [ASM_SIMP_TAC std_ss [], ONCE_REWRITE_TAC[AND_IMP_INTRO]] THEN
      DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_ADD) THEN
      SIMP_TAC std_ss [ETA_AX, REAL_ARITH ``f + (g - f):real = g``] THEN
      DISCH_TAC THEN
      ONCE_REWRITE_TAC [METIS []
      ``(\x:real. g x - (f 0 x):real) =
            (\x. g x - (\x. (f:num->real->real) 0 x) x)``] THEN
      ASM_SIMP_TAC std_ss [INTEGRAL_SUB, ETA_AX] THEN
      MP_TAC(ISPECL [``sequentially``, ``integral s (f (0:num):real->real)``]
                    LIM_CONST) THEN
      REWRITE_TAC[AND_IMP_INTRO] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN
      SIMP_TAC std_ss [ETA_AX, REAL_ARITH ``f + (g - f):real = g``, METIS []
       ``(\x. f 0 x) = (f:num->real->real) 0``] THEN
      REWRITE_TAC[ADD1] THEN
      ONCE_REWRITE_TAC [METIS [] ``(\x. integral s ((f:num->real->real) (x + 1))) =
                                   (\x. (\a. integral s (f (a))) (x + 1))``] THEN
      SIMP_TAC std_ss [ISPECL[``f:num->real``, ``l:real``, ``1:num``] SEQ_OFFSET_REV]
      ] ]
  THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
  SUBGOAL_THEN
   ``!x:real k:num. x IN s ==> (f k x) <= (g x):real``
  ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN
    MATCH_MP_TAC(ISPEC ``sequentially`` LIM_DROP_LBOUND) THEN
    EXISTS_TAC ``\k. (f:num->real->real) k x`` THEN
    ASM_SIMP_TAC std_ss [TRIVIAL_LIMIT_SEQUENTIALLY, EVENTUALLY_SEQUENTIALLY] THEN
    EXISTS_TAC ``k:num`` THEN SPEC_TAC(``k:num``,``k:num``) THEN
    ONCE_REWRITE_TAC [METIS [] ``f k x <= (f:num->real->real) x' x <=>
                         (\k x'. f k x <= f x' x) k x'``] THEN
    MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
    SIMP_TAC std_ss [REAL_LE_TRANS, REAL_LE_REFL] THEN
    CONJ_TAC THENL [METIS_TAC [REAL_LE_TRANS], ALL_TAC] THEN
    ASM_SIMP_TAC std_ss [REAL_LE_REFL],
    ALL_TAC] THEN
  SUBGOAL_THEN
   ``?i. ((\k:num. integral s (f k:real->real)) --> i)
        sequentially``
  CHOOSE_TAC THENL
   [MATCH_MP_TAC BOUNDED_INCREASING_CONVERGENT THEN ASM_SIMP_TAC std_ss [] THEN
    GEN_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_SIMP_TAC std_ss [],
    ALL_TAC] THEN
  SUBGOAL_THEN
   ``!k. (integral s ((f:num->real->real) k)) <= i``
  ASSUME_TAC THENL
    [GEN_TAC THEN MATCH_MP_TAC(ISPEC ``sequentially`` LIM_DROP_LBOUND) THEN
     EXISTS_TAC ``\k. integral(s) ((f:num->real->real) k)`` THEN
     ASM_SIMP_TAC std_ss [TRIVIAL_LIMIT_SEQUENTIALLY, EVENTUALLY_SEQUENTIALLY] THEN
     EXISTS_TAC ``k:num`` THEN SPEC_TAC(``k:num``,``k:num``) THEN
     ONCE_REWRITE_TAC [METIS []
     ``(integral s (f k) <= integral s ((f:num->real->real) x)) <=>
       (\k x. integral s (f k) <= integral s (f x)) k x``] THEN
     MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
     ASM_SIMP_TAC std_ss [REAL_LE_REFL, REAL_LE_TRANS] THEN CONJ_TAC THENL
     [METIS_TAC [REAL_LE_TRANS], ALL_TAC] THEN
     GEN_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_SIMP_TAC std_ss [],
     ALL_TAC] THEN
  SUBGOAL_THEN ``((g:real->real) has_integral i) s`` ASSUME_TAC THENL
   [ALL_TAC,
    CONJ_TAC THENL [ASM_MESON_TAC[integrable_on], ALL_TAC] THEN
    FIRST_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN
    ASM_REWRITE_TAC[]] THEN
  REWRITE_TAC[HAS_INTEGRAL_ALT] THEN
  MP_TAC(ISPECL
   [``\k x. if x IN s then (f:num->real->real) k x else 0``,
    ``\x. if x IN s then (g:real->real) x else 0``] MONOTONE_CONVERGENCE_INTERVAL) THEN
  DISCH_TAC THEN
  KNOW_TAC ``(!(a :real) (b :real).
       (!(k :num).
          (\(k :num) (x :real).
             if x IN (s :real -> bool) then (f :num -> real -> real) k x
             else (0 :real)) k integrable_on interval [(a,b)]) /\
       (!(k :num) (x :real).
          x IN interval [(a,b)] ==>
          (\(k :num) (x :real). if x IN s then f k x else (0 :real)) k x <=
          (\(k :num) (x :real). if x IN s then f k x else (0 :real)) (SUC k)
            x) /\
       (!(x :real).
          x IN interval [(a,b)] ==>
          (((\(k :num).
               (\(k :num) (x :real). if x IN s then f k x else (0 :real)) k
                 x) -->
            (\(x :real). if x IN s then (g :real -> real) x else (0 :real))
              x) sequentially :bool)) /\
       (bounded
          {integral (interval [(a,b)])
             ((\(k :num) (x :real). if x IN s then f k x else (0 :real))
                k) |
           k IN univ((:num) :num itself)} :bool)) ==>
           (!(a :real) (b :real).
       (\(x :real). if x IN s then g x else (0 :real)) integrable_on
       interval [(a,b)] /\
       (((\(k :num).
            integral (interval [(a,b)])
              ((\(k :num) (x :real). if x IN s then f k x else (0 :real))
                 k)) -->
         integral (interval [(a,b)])
           (\(x :real). if x IN s then g x else (0 :real))) sequentially :
          bool))`` THENL [METIS_TAC [], POP_ASSUM K_TAC] THEN
  KNOW_TAC ``(!(a :real) (b :real).
       (!(k :num).
          (\(k :num) (x :real).
             if x IN (s :real -> bool) then (f :num -> real -> real) k x
             else (0 :real)) k integrable_on interval [(a,b)]) /\
       (!(k :num) (x :real).
          x IN interval [(a,b)] ==>
          (\(k :num) (x :real). if x IN s then f k x else (0 :real)) k x <=
          (\(k :num) (x :real). if x IN s then f k x else (0 :real)) (SUC k)
            x) /\
       (!(x :real).
          x IN interval [(a,b)] ==>
          (((\(k :num).
               (\(k :num) (x :real). if x IN s then f k x else (0 :real)) k
                 x) -->
            (\(x :real). if x IN s then (g :real -> real) x else (0 :real))
              x) sequentially :bool)) /\
       (bounded
          {integral (interval [(a,b)])
             ((\(k :num) (x :real). if x IN s then f k x else (0 :real))
                k) |
           k IN univ((:num) :num itself)} :bool))`` THENL
   [REPEAT GEN_TAC THEN SIMP_TAC std_ss [] THEN
    MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
     [UNDISCH_TAC ``!k. (f:num->real->real) k integrable_on s`` THEN DISCH_TAC THEN
      FIRST_ASSUM(MP_TAC o ONCE_REWRITE_RULE [INTEGRABLE_ALT]) THEN
      SIMP_TAC std_ss [],
      DISCH_TAC] THEN
    CONJ_TAC THENL
     [REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [REAL_LE_REFL],
      ALL_TAC] THEN
    CONJ_TAC THENL
     [REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [LIM_CONST],
      ALL_TAC] THEN
     UNDISCH_TAC
     ``bounded {integral s ((f:num->real->real) k) | k IN univ(:num)}`` THEN
    DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [bounded_def]) THEN
    ONCE_REWRITE_TAC [METIS [] ``integral s (f k) = (\k. integral s (f k)) k``] THEN
    ONCE_REWRITE_TAC [METIS []
        ``integral (interval [(a,b)]) (\x. if x IN s then f k x else 0) =
          (\k. integral (interval [(a,b)]) (\x. if x IN s then f k x else 0))k``] THEN
    ONCE_REWRITE_TAC[GSYM IMAGE_DEF] THEN BETA_TAC THEN
    SIMP_TAC std_ss [bounded_def, FORALL_IN_IMAGE, IN_UNIV] THEN
    DISCH_THEN (X_CHOOSE_TAC ``x:real``) THEN EXISTS_TAC ``x:real`` THEN
    X_GEN_TAC ``k:num`` THEN POP_ASSUM (MP_TAC o Q.SPEC `k:num`) THEN
    MATCH_MP_TAC(REAL_ARITH
     ``&0 <= y /\ y <= x ==> abs(x) <= a ==> abs(y) <= a:real``) THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC INTEGRAL_DROP_POS THEN ASM_SIMP_TAC std_ss [] THEN
      REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
      ASM_SIMP_TAC std_ss [REAL_LE_REFL],
      ALL_TAC] THEN
    GEN_REWR_TAC (RAND_CONV) [GSYM INTEGRAL_RESTRICT_UNIV] THEN
    MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN
    ASM_SIMP_TAC std_ss [SUBSET_UNIV, IN_UNIV] THEN
    ASM_SIMP_TAC std_ss [INTEGRABLE_RESTRICT_UNIV, ETA_AX, METIS []
     ``(\x. f k x) = (f:num->real->real) k``] THEN
    GEN_TAC THEN COND_CASES_TAC THEN
    ASM_SIMP_TAC std_ss [REAL_LE_REFL, REAL_LE_REFL],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  SIMP_TAC std_ss [FORALL_AND_THM] THEN STRIP_TAC THEN ASM_SIMP_TAC std_ss [] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  UNDISCH_TAC ``((\k. integral s ((f:num->real->real) k)) --> i) sequentially`` THEN
  DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [LIM_SEQUENTIALLY]) THEN
  DISCH_THEN(MP_TAC o SPEC ``e / &4:real``) THEN
  ASM_SIMP_TAC arith_ss [dist, REAL_LT_DIV, REAL_LT] THEN
  DISCH_THEN(X_CHOOSE_THEN ``N:num`` STRIP_ASSUME_TAC) THEN
  UNDISCH_TAC ``!k. (f:num->real->real) k integrable_on s`` THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o REWRITE_RULE [HAS_INTEGRAL_INTEGRAL]) THEN
  GEN_REWR_TAC (LAND_CONV o BINDER_CONV) [HAS_INTEGRAL_ALT] THEN
  SIMP_TAC std_ss [FORALL_AND_THM] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(MP_TAC o SPECL [``N:num``, ``e / &4:real``]) THEN
  ASM_SIMP_TAC arith_ss [dist, REAL_LT_DIV, REAL_LT] THEN
  STRIP_TAC THEN EXISTS_TAC ``B:real`` THEN ASM_SIMP_TAC std_ss [] THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [``a:real``, ``b:real``]) THEN
  ASM_REWRITE_TAC[] THEN
  FIRST_ASSUM(MP_TAC o C MATCH_MP (ARITH_PROVE ``N:num <= N``)) THEN
  REWRITE_TAC[AND_IMP_INTRO] THEN
  DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
   ``abs(x - y) < e / &4 /\ abs(z - x) < e / &4
    ==> abs(z - y) < e / &4 + e / &4:real``)) THEN
  UNDISCH_TAC `` !a b.
            ((\k.
                integral (interval [(a,b)])
                  (\x. if x IN s then (f:num->real->real) k x else 0)) -->
             integral (interval [(a,b)]) (\x. if x IN s then g x else 0))
              sequentially`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [LIM_SEQUENTIALLY]) THEN
  DISCH_THEN(MP_TAC o SPECL [``a:real``, ``b:real``, ``e / &4 + e / &4:real``]) THEN
  KNOW_TAC ``e / &4 + e / &4:real = e / &2:real`` THENL
  [REWRITE_TAC [REAL_DOUBLE, real_div, REAL_MUL_ASSOC] THEN
   REWRITE_TAC [GSYM real_div] THEN
   SIMP_TAC std_ss [REAL_EQ_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
   ONCE_REWRITE_TAC [real_div] THEN
   ONCE_REWRITE_TAC [REAL_ARITH ``a * b * c * d =((a * d) * c) * b:real``] THEN
   REWRITE_TAC [REAL_ARITH ``2 * 2 = 4:real``] THEN
   SIMP_TAC std_ss [REAL_MUL_RINV, REAL_ARITH ``4 <> 0:real``] THEN REAL_ARITH_TAC,
   DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  ASM_SIMP_TAC std_ss [dist, REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN ``M:num`` (MP_TAC o SPEC ``M + N:num``)) THEN
  REWRITE_TAC[LE_ADD] THEN
  GEN_REWR_TAC (RAND_CONV o RAND_CONV o RAND_CONV) [GSYM REAL_HALF] THEN
  MATCH_MP_TAC(REAL_ARITH
   ``f1 <= f2 /\ f2 <= i
    ==> abs(f2 - g) < e / &2 ==> abs(f1 - i) < e / &2 ==>
        abs(g - i) < e / &2 + e / &2:real``) THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_SIMP_TAC std_ss [] THEN
    X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN
    MP_TAC(ISPEC
        ``\m n:num. (f m (x:real)) <= (f n x):real``
        TRANSITIVE_STEPWISE_LE) THEN
    SIMP_TAC std_ss [REAL_LE_REFL, REAL_LE_TRANS] THEN
    KNOW_TAC ``(!(x' :num) (y :num) (z :num).
        (f :num -> real -> real) x' (x :real) <= f y x /\ f y x <= f z x ==>
        f x' x <= f z x) /\ (!(n :num). f n x <= f (SUC n) x)`` THENL
    [METIS_TAC [REAL_LE_TRANS], DISCH_TAC THEN
     ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    DISCH_THEN MATCH_MP_TAC THEN ARITH_TAC,
    ALL_TAC] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC ``(integral s ((f:num->real->real) (M + N)))`` THEN
  ASM_SIMP_TAC std_ss [] THEN
  GEN_REWR_TAC (RAND_CONV) [GSYM INTEGRAL_RESTRICT_UNIV] THEN
  MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN
  ASM_SIMP_TAC std_ss [SUBSET_UNIV, IN_UNIV] THEN
  ASM_SIMP_TAC std_ss [INTEGRABLE_RESTRICT_UNIV, ETA_AX, METIS []
   ``(\x. f (M + N) x) = (f:num->real->real) (M + N)``] THEN
  GEN_TAC THEN COND_CASES_TAC THEN
  ASM_SIMP_TAC std_ss [REAL_LE_REFL]
QED

val MONOTONE_CONVERGENCE_DECREASING = store_thm ("MONOTONE_CONVERGENCE_DECREASING",
 ``!f:num->real->real g s.
        (!k. (f k) integrable_on s) /\
        (!k x. x IN s ==> (f (SUC k) x) <= (f k x)) /\
        (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) /\
        bounded {integral s (f k) | k IN univ(:num)}
        ==> g integrable_on s /\
            ((\k. integral s (f k)) --> integral s g) sequentially``,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  MP_TAC(ISPECL
   [``(\k x. -(f k x)):num->real->real``,
    ``(\x. -(g x)):real->real``, ``s:real->bool``]
        MONOTONE_CONVERGENCE_INCREASING) THEN
  FIRST_ASSUM MP_TAC THEN
  MATCH_MP_TAC(TAUT `(a ==> b) /\ (c ==> d) ==> a ==> (b ==> c) ==> d`) THEN
  SIMP_TAC std_ss [] THEN CONJ_TAC THENL
   [REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL
     [DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `k:num`) THEN
      DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_NEG) THEN SIMP_TAC std_ss [],
      SIMP_TAC std_ss [REAL_LE_NEG2],
      REPEAT STRIP_TAC THEN
      ONCE_REWRITE_TAC [METIS []
      ``(\k. -f k x) = (\k. -((\k. (f:num->real->real) k x) k))``] THEN
      MATCH_MP_TAC LIM_NEG THEN ASM_SIMP_TAC std_ss [],
      ALL_TAC] THEN
    DISCH_TAC THEN MATCH_MP_TAC BOUNDED_SUBSET THEN
    EXISTS_TAC ``IMAGE (\x. -x)
                      {integral s (f k:real->real) | k IN univ(:num)}`` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN
      ASM_SIMP_TAC std_ss [LINEAR_COMPOSE_NEG, LINEAR_ID],
      ONCE_REWRITE_TAC [METIS [] ``integral s (f k) = (\k. integral s (f k)) k``] THEN
      ONCE_REWRITE_TAC [METIS [] ``integral s (\x. -f k x) =
                              (\k. integral s (\x. -f k x)) k``] THEN
      ONCE_REWRITE_TAC[GSYM IMAGE_DEF] THEN REWRITE_TAC[GSYM IMAGE_COMPOSE] THEN
      REWRITE_TAC[SUBSET_DEF, IN_IMAGE] THEN
      GEN_TAC THEN STRIP_TAC THEN EXISTS_TAC ``x':num`` THEN
      REPEAT STRIP_TAC THEN ASM_SIMP_TAC std_ss [o_THM] THEN
      ONCE_ASM_REWRITE_TAC [] THEN BETA_TAC THEN
      MATCH_MP_TAC INTEGRAL_NEG THEN ASM_REWRITE_TAC[]],
    ALL_TAC] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (MP_TAC o MATCH_MP INTEGRABLE_NEG) (MP_TAC o MATCH_MP LIM_NEG)) THEN
  SIMP_TAC std_ss [REAL_NEG_NEG, ETA_AX] THEN
  DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN
  ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN
  BINOP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN TRY GEN_TAC THEN BETA_TAC THEN
  MATCH_MP_TAC(REAL_ARITH ``(x:real = -y) ==> (-x = y)``) THEN
  MATCH_MP_TAC INTEGRAL_NEG THEN ASM_REWRITE_TAC[]);

val MONOTONE_CONVERGENCE_INCREASING_AE = store_thm ("MONOTONE_CONVERGENCE_INCREASING_AE",
 ``!f:num->real->real g s t.
        (!k. (f k) integrable_on s) /\
        negligible t /\
        (!k x. x IN s DIFF t ==> (f k x) <= (f (SUC k) x)) /\
        (!x. x IN s DIFF t ==> ((\k. f k x) --> g x) sequentially) /\
        bounded {integral s (f k) | k IN univ(:num)}
        ==> g integrable_on s /\
            ((\k. integral s (f k)) --> integral s g) sequentially``,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MP_TAC(ISPECL
   [``\n x. if x IN t then 0
           else (f:num->real->real) n x``,
    ``\x. if x IN t then 0
           else (g:real->real) x``, ``s:real->bool``]
        MONOTONE_CONVERGENCE_INCREASING) THEN
  ASM_SIMP_TAC std_ss [] THEN
  KNOW_TAC ``(!(k :num).
        (\(x :real).
           if x IN (t :real -> bool) then (0 :real)
           else (f :num -> real -> real) k x) integrable_on
        (s :real -> bool)) /\
     (!(k :num) (x :real).
        x IN s ==>
        (if x IN t then (0 :real) else f k x) <=
        if x IN t then (0 :real) else f (SUC k) x) /\
     (!(x :real).
        x IN s ==>
        (((\(k :num). if x IN t then (0 :real) else f k x) -->
          if x IN t then (0 :real) else (g :real -> real) x) sequentially :
           bool)) /\
     (bounded
        {integral s (\(x :real). if x IN t then (0 :real) else f k x) |
         k IN univ((:num) :num itself)} :bool)`` THENL
   [REPEAT CONJ_TAC THENL
     [X_GEN_TAC ``k:num`` THEN
      MATCH_MP_TAC(REWRITE_RULE[AND_IMP_INTRO] INTEGRABLE_SPIKE) THEN
      EXISTS_TAC ``(f:num->real->real) k`` THEN
      EXISTS_TAC ``t:real->bool`` THEN
      ASM_SIMP_TAC std_ss [IN_DIFF],
      REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
      ASM_REWRITE_TAC[REAL_LE_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_SET_TAC[],
      X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
      ASM_CASES_TAC ``(x:real) IN t`` THEN ASM_REWRITE_TAC[LIM_CONST] THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF],
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        BOUNDED_SUBSET)) THEN
      ONCE_REWRITE_TAC [METIS []
         ``integral s (f k) = (\k. integral s (f k)) k``] THEN
      ONCE_REWRITE_TAC [METIS [] ``integral (s :real -> bool)
       (\(x :real). if x IN (t :real -> bool) then (0 :real)
                    else (f :num -> real -> real) k x) =
          (\k. integral (s :real -> bool)
       (\(x :real). if x IN (t :real -> bool) then (0 :real)
                    else (f :num -> real -> real) k x)) k``] THEN
      MATCH_MP_TAC(SET_RULE
       ``(!x. x IN s ==> (f x = g x))
        ==> {f x | x IN s} SUBSET {g x | x IN s}``) THEN
      BETA_TAC THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN
      EXISTS_TAC ``t:real->bool`` THEN
      ASM_SIMP_TAC std_ss [IN_DIFF]],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
     [MATCH_MP_TAC INTEGRABLE_SPIKE THEN EXISTS_TAC ``t:real->bool`` THEN
      ASM_SIMP_TAC std_ss [IN_DIFF],
      MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN BINOP_TAC THEN
      REWRITE_TAC[FUN_EQ_THM] THEN REPEAT GEN_TAC THEN BETA_TAC THEN
      MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC ``t:real->bool`` THEN
      ASM_SIMP_TAC std_ss [IN_DIFF]]]);

val MONOTONE_CONVERGENCE_DECREASING_AE = store_thm ("MONOTONE_CONVERGENCE_DECREASING_AE",
 ``!f:num->real->real g s t.
        (!k. (f k) integrable_on s) /\
        negligible t /\
        (!k x. x IN s DIFF t ==> (f (SUC k) x) <= (f k x)) /\
        (!x. x IN s DIFF t ==> ((\k. f k x) --> g x) sequentially) /\
        bounded {integral s (f k) | k IN univ(:num)}
        ==> g integrable_on s /\
            ((\k. integral s (f k)) --> integral s g) sequentially``,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MP_TAC(ISPECL
   [``\n x. if x IN t then 0
           else (f:num->real->real) n x``,
    ``\x. if x IN t then 0
           else (g:real->real) x``, ``s:real->bool``]
        MONOTONE_CONVERGENCE_DECREASING) THEN
  ASM_SIMP_TAC std_ss [] THEN
  KNOW_TAC ``(!(k :num).
        (\(x :real).
           if x IN (t :real -> bool) then (0 :real)
           else (f :num -> real -> real) k x) integrable_on
        (s :real -> bool)) /\
     (!(k :num) (x :real).
        x IN s ==>
        (if x IN t then (0 :real) else f (SUC k) x) <=
        if x IN t then (0 :real) else f k x) /\
     (!(x :real).
        x IN s ==>
        (((\(k :num). if x IN t then (0 :real) else f k x) -->
          if x IN t then (0 :real) else (g :real -> real) x) sequentially :
           bool)) /\
     (bounded
        {integral s (\(x :real). if x IN t then (0 :real) else f k x) |
         k IN univ((:num) :num itself)} :bool)`` THENL
   [REPEAT CONJ_TAC THENL
     [X_GEN_TAC ``k:num`` THEN
      MATCH_MP_TAC(REWRITE_RULE[AND_IMP_INTRO] INTEGRABLE_SPIKE) THEN
      EXISTS_TAC ``(f:num->real->real) k`` THEN
      EXISTS_TAC ``t:real->bool`` THEN
      ASM_SIMP_TAC std_ss [IN_DIFF],
      REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
      ASM_REWRITE_TAC[REAL_LE_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_SET_TAC[],
      X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
      ASM_CASES_TAC ``(x:real) IN t`` THEN ASM_REWRITE_TAC[LIM_CONST] THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF],
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        BOUNDED_SUBSET)) THEN
      ONCE_REWRITE_TAC [METIS []
          ``integral s (f k) = (\k. integral s (f k)) k``] THEN
      ONCE_REWRITE_TAC [METIS [] ``integral (s :real -> bool)
       (\(x :real). if x IN (t :real -> bool) then (0 :real)
                    else (f :num -> real -> real) k x) =
          (\k. integral (s :real -> bool)
       (\(x :real). if x IN (t :real -> bool) then (0 :real)
                    else (f :num -> real -> real) k x)) k``] THEN
      MATCH_MP_TAC(SET_RULE
       ``(!x. x IN s ==> (f x = g x))
        ==> {f x | x IN s} SUBSET {g x | x IN s}``) THEN BETA_TAC THEN
      REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN
      EXISTS_TAC ``t:real->bool`` THEN
      ASM_SIMP_TAC std_ss [IN_DIFF]],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
     [MATCH_MP_TAC INTEGRABLE_SPIKE THEN EXISTS_TAC ``t:real->bool`` THEN
      ASM_SIMP_TAC std_ss [IN_DIFF],
      MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN BINOP_TAC THEN
      REWRITE_TAC[FUN_EQ_THM] THEN REPEAT GEN_TAC THEN BETA_TAC THEN
      MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC ``t:real->bool`` THEN
      ASM_SIMP_TAC std_ss [IN_DIFF]]]);

(* ------------------------------------------------------------------------- *)
(* More lemmas about existence and bounds between integrals.                 *)
(* ------------------------------------------------------------------------- *)

val lemma = prove (
 ``(!e:real. &0 < e ==> x < y + e) ==> x <= y``,
   DISCH_THEN(MP_TAC o SPEC ``x - y:real``) THEN REAL_ARITH_TAC);

val INTEGRAL_ABS_BOUND_INTEGRAL = store_thm ("INTEGRAL_ABS_BOUND_INTEGRAL",
 ``!f:real->real g s.
        f integrable_on s /\ g integrable_on s /\
        (!x. x IN s ==> abs(f x) <= (g x))
        ==> abs(integral s f) <= (integral s g)``,
  SUBGOAL_THEN
   ``!f:real->real g a b.
        f integrable_on interval[a,b] /\ g integrable_on interval[a,b] /\
        (!x. x IN interval[a,b] ==> abs(f x) <= (g x))
        ==> abs(integral(interval[a,b]) f) <= (integral(interval[a,b]) g)``
  ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN
    X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
    UNDISCH_TAC ``(f:real->real) integrable_on interval[a,b]`` THEN
    DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN
    FIRST_X_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN
    REWRITE_TAC[has_integral] THEN DISCH_THEN(MP_TAC o SPEC ``e / &2:real``) THEN
    ASM_SIMP_TAC std_ss [REAL_HALF, LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC ``d1:real->real->bool`` THEN STRIP_TAC THEN
    DISCH_THEN(MP_TAC o SPEC ``e / &2:real``) THEN
    ASM_SIMP_TAC std_ss [REAL_HALF, LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC ``d2:real->real->bool`` THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    MP_TAC(ISPECL [``d1:real->real->bool``, ``d2:real->real->bool``]
                  GAUGE_INTER) THEN
    ASM_REWRITE_TAC[] THEN
    DISCH_THEN(MP_TAC o MATCH_MP FINE_DIVISION_EXISTS) THEN
    DISCH_THEN(MP_TAC o SPECL [``a:real``, ``b:real``]) THEN
    SIMP_TAC std_ss [FINE_INTER, LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC ``p:(real#(real->bool))->bool`` THEN STRIP_TAC THEN
    DISCH_THEN(MP_TAC o SPEC ``p:(real#(real->bool))->bool``) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``p:(real#(real->bool))->bool``) THEN
    ASM_REWRITE_TAC[] THEN
    SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
    MATCH_MP_TAC(REAL_ARITH
     ``abs(sg) <= dsa
      ==> abs(dsa - dia) * &2 < e ==> abs(sg - ig) * &2 < e
          ==> abs(ig) < dia + e:real``) THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
    ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC SUM_ABS_LE THEN
    ASM_SIMP_TAC std_ss [o_DEF, FORALL_PROD] THEN
    MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN DISCH_TAC THEN
    REWRITE_TAC[ABS_MUL] THEN
    MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[ABS_POS] THEN
    REWRITE_TAC[REAL_ARITH ``abs x <= x <=> &0 <= x:real``] THEN
    ASM_MESON_TAC[CONTENT_POS_LE, TAGGED_DIVISION_OF, SUBSET_DEF],
    ALL_TAC] THEN
  REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN (fn th =>
     ASSUME_TAC(CONJUNCT1(ONCE_REWRITE_RULE [INTEGRABLE_ALT] th)) THEN
     MP_TAC(MATCH_MP INTEGRABLE_INTEGRAL th))) THEN
  ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN
  DISCH_TAC THEN DISCH_TAC THEN MATCH_MP_TAC lemma THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  UNDISCH_TAC ``!e:real. 0 < e ==>
        ?B. 0 < B /\ !a b. ball (0,B) SUBSET interval [(a,b)] ==>
            ?z. ((\x. if x IN s then g x else 0) has_integral z)
                (interval [(a,b)]) /\ abs (z - integral s g) < e`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM (MP_TAC o SPEC ``e / &2:real``) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN ``B1:real``
   (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN ``B2:real``
   (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN
  MP_TAC(ISPEC ``ball(0,max B1 B2:real):real->bool``
    BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
  SIMP_TAC std_ss [BOUNDED_BALL, LEFT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[BALL_MAX_UNION, UNION_SUBSET] THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN
  DISCH_THEN(CONJUNCTS_THEN(ANTE_RES_THEN MP_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN ``z:real`` (CONJUNCTS_THEN2 ASSUME_TAC
     (fn th => DISCH_THEN(X_CHOOSE_THEN ``w:real``
                (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MP_TAC th))) THEN
  ASM_REWRITE_TAC[] THEN
  SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
  MATCH_MP_TAC(REAL_ARITH
     ``abs(sg) <= dsa
      ==> abs(dsa - dia) * &2 < e ==> abs(sg - ig) * &2 < e
          ==> abs(ig) < dia + e:real``) THEN
  REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM o MATCH_MP INTEGRAL_UNIQUE)) THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
  REPEAT STRIP_TAC THEN SIMP_TAC std_ss [] THEN
  COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [ABS_0, REAL_LE_REFL]);

val INTEGRAL_ABS_BOUND_INTEGRAL_COMPONENT = store_thm ("INTEGRAL_ABS_BOUND_INTEGRAL_COMPONENT",
 ``!f:real->real g:real->real s.
        f integrable_on s /\ g integrable_on s /\
        (!x. x IN s ==> abs(f x) <= (g x))
        ==> abs(integral s f) <= (integral s g)``,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC ``(integral s ((\y. (y)) o (g:real->real)))`` THEN
  SUBGOAL_THEN ``linear(\y:real. (y))`` ASSUME_TAC THENL
   [ASM_SIMP_TAC std_ss [linear], ALL_TAC] THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC INTEGRAL_ABS_BOUND_INTEGRAL THEN
    ASM_SIMP_TAC std_ss [o_THM] THEN MATCH_MP_TAC INTEGRABLE_LINEAR THEN
    ASM_SIMP_TAC std_ss [], ALL_TAC] THEN
  SUBGOAL_THEN
   ``integral s ((\y. (y)) o (g:real->real)) =
        (\y. (y)) (integral s g)``
  SUBST1_TAC THENL
   [MATCH_MP_TAC INTEGRAL_LINEAR THEN ASM_REWRITE_TAC[],
    SIMP_TAC std_ss [REAL_LE_REFL]]);

val HAS_INTEGRAL_ABS_BOUND_INTEGRAL_COMPONENT = store_thm ("HAS_INTEGRAL_ABS_BOUND_INTEGRAL_COMPONENT",
 ``!f:real->real g:real->real s i j.
        (f has_integral i) s /\ (g has_integral j) s /\
        (!x. x IN s ==> abs(f x) <= (g x))
        ==> abs(i) <= j``,
  REPEAT STRIP_TAC THEN
  REPEAT(FIRST_X_ASSUM(fn th =>
   SUBST1_TAC(SYM(MATCH_MP INTEGRAL_UNIQUE th)) THEN
   ASSUME_TAC(MATCH_MP HAS_INTEGRAL_INTEGRABLE th))) THEN
  MATCH_MP_TAC INTEGRAL_ABS_BOUND_INTEGRAL_COMPONENT THEN
  ASM_SIMP_TAC std_ss []);

val lemma = prove (
   ``!f:real->real g.
          (!a b. f integrable_on interval[a,b]) /\
          (!x. abs(f x) <= (g x)) /\
          g integrable_on univ(:real)
          ==> f integrable_on univ(:real)``,
    REPEAT GEN_TAC THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    ONCE_REWRITE_TAC[INTEGRABLE_ALT_SUBSET] THEN
    ASM_SIMP_TAC std_ss [IN_UNIV, ETA_AX] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o SPEC ``e:real``) THEN
    ASM_CASES_TAC ``&0 < e:real`` THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN (X_CHOOSE_TAC ``B:real``) THEN EXISTS_TAC ``B:real`` THEN
    POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
    DISCH_TAC THEN REPEAT GEN_TAC THEN
    POP_ASSUM (MP_TAC o SPECL [``a:real``,``b:real``,``c:real``,``d:real``]) THEN
    DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC(REAL_ARITH ``a <= b ==> b < c ==> a < c:real``) THEN
    ONCE_REWRITE_TAC[ABS_SUB] THEN
    ASM_SIMP_TAC std_ss [GSYM INTEGRAL_DIFF, NEGLIGIBLE_EMPTY,
     METIS [SUBSET_DEF, IN_DIFF, NOT_IN_EMPTY, EXTENSION]
      ``s SUBSET t ==> (s DIFF t = {})``] THEN
    SIMP_TAC std_ss [] THEN
    MATCH_MP_TAC(REAL_ARITH ``x <= y ==> x <= abs y:real``) THEN
    MATCH_MP_TAC INTEGRAL_ABS_BOUND_INTEGRAL THEN
    METIS_TAC[integrable_on, HAS_INTEGRAL_DIFF, NEGLIGIBLE_EMPTY,
                 SET_RULE ``s SUBSET t ==> (s DIFF t = {})``]);

val INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND =  store_thm ("INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND",
 ``!f:real->real g s.
        (!a b. (\x. if x IN s then f x else 0)
               integrable_on interval[a,b]) /\
        (!x. x IN s ==> abs(f x) <= (g x)) /\
        g integrable_on s
        ==> f integrable_on s``,
  REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN
  DISCH_TAC THEN MATCH_MP_TAC lemma THEN
  EXISTS_TAC ``(\x. if x IN s then g x else 0):real->real`` THEN
  ASM_SIMP_TAC std_ss [] THEN
  GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [ABS_0, REAL_POS]);

(* ------------------------------------------------------------------------- *)
(* Explicit limit statement for integrals over [0,inf].                      *)
(* ------------------------------------------------------------------------- *)

Theorem HAS_INTEGRAL_LIM_AT_POSINFINITY :
    !f l:real.
        (f has_integral l) {t | &0 <= t} <=>
        (!a. f integrable_on interval[0,a]) /\
        ((\a. integral (interval[0,a]) f) --> l) at_posinfinity
Proof
  REPEAT GEN_TAC THEN
  GEN_REWR_TAC LAND_CONV [HAS_INTEGRAL_ALT] THEN
  SIMP_TAC std_ss [INTEGRAL_RESTRICT_INTER, INTEGRABLE_RESTRICT_INTER] THEN
  SUBGOAL_THEN
   ``!a b. {t | &0 <= t} INTER interval[a,b] =
          interval[(max (&0) (a:real)),b]``
   (fn th => REWRITE_TAC[th])
  THENL
   [SIMP_TAC std_ss [EXTENSION, IN_INTER, IN_INTERVAL, GSPECIFICATION, max_def] THEN
    rpt GEN_TAC >> EQ_TAC >> Cases_on `0 <= a` >> rw [] \\
    REAL_ASM_ARITH_TAC,
    ALL_TAC] THEN
  REWRITE_TAC[LIM_AT_POSINFINITY, dist, real_ge] THEN
  EQ_TAC THEN STRIP_TAC THEN CONJ_TAC THENL (* 4 subgoals *)
  [ (* goal 1 (of 4) *)
    X_GEN_TAC ``a:real`` THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [``0:real``, ``a:real``]) THEN
    REWRITE_TAC[REAL_MAX_REFL],
    (* goal 2 (of 4) *)
    X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``e:real``) THEN ASM_SIMP_TAC std_ss [] THEN
    DISCH_THEN (X_CHOOSE_TAC ``B:real``) THEN EXISTS_TAC ``B:real`` THEN
    POP_ASSUM MP_TAC THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC) THEN
    X_GEN_TAC ``b:real`` THEN DISCH_TAC THEN
    UNDISCH_TAC `` !a b:real.
        ball (0,B) SUBSET interval [(a,b)] ==>
        abs (integral (interval [(max 0 a,b)]) f - l) < e`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM (MP_TAC o SPECL [``(-b:real)``, ``b:real``]) THEN
    REWRITE_TAC[] THEN
    SUBGOAL_THEN ``max (&0) (-b) = &0:real`` SUBST1_TAC THENL
    [ Suff `-b <= 0` >- rw [REAL_MAX_ALT] >> rw [] \\
      MATCH_MP_TAC REAL_LT_IMP_LE \\
      MATCH_MP_TAC REAL_LTE_TRANS \\
      Q.EXISTS_TAC `B` >> art [], SIMP_TAC std_ss []] THEN
    DISCH_THEN MATCH_MP_TAC THEN
    REWRITE_TAC[BALL, SUBSET_INTERVAL] THEN POP_ASSUM MP_TAC THEN
    POP_ASSUM MP_TAC THEN REAL_ARITH_TAC,
    (* goal 3 (of 4) *)
    MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN
    UNDISCH_TAC ``!a. f integrable_on interval [(0,a)]`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``b:real``) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTEGRABLE_SUBINTERVAL) THEN
    SIMP_TAC std_ss [SUBSET_INTERVAL, REAL_LE_REFL] THEN
    rw [REAL_MAX_LE, REAL_LE_MAX],
    (* goal 4 (of 4) *)
    X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``e:real``) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN ``B:real`` ASSUME_TAC) THEN
    EXISTS_TAC ``abs B + &1:real`` THEN
    STRONG_CONJ_TAC (* 0 < abs B + 1 *)
    >- (`0 <= abs B` by PROVE_TAC [ABS_POS] >> POP_ASSUM MP_TAC \\
        REAL_ARITH_TAC) \\
    DISCH_TAC \\
    MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN
    SIMP_TAC std_ss [BALL, SUBSET_INTERVAL] THEN STRIP_TAC THEN
    (* stage work *)
    POP_ASSUM MP_TAC \\
    Know `0 - (abs B + 1) < 0 + (abs B + 1)`
    >- (rw [] >> Q.PAT_X_ASSUM `0 < abs B + 1` MP_TAC \\
        REAL_ARITH_TAC) >> rw [] \\
    Know `max (&0) (a) = &0:real`
    >- (Suff `a <= 0` >- rw [REAL_MAX_ALT] \\
        MATCH_MP_TAC REAL_LE_TRANS \\
        Q.EXISTS_TAC `-(abs B + 1)` >> art [] \\
        MATCH_MP_TAC REAL_LT_IMP_LE \\
        Q.PAT_X_ASSUM `0 < abs B + 1` MP_TAC \\
        REAL_ARITH_TAC) >> Rewr' \\
    fs [] >> FIRST_X_ASSUM MATCH_MP_TAC \\
    POP_ASSUM MP_TAC \\
    REAL_ARITH_TAC ]
QED

val FLOOR_POS = store_thm ("FLOOR_POS",
 ``!x. &0 <= x ==> (?n. flr x = &n)``,
  GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC [NUM_FLOOR_def] THEN
  METIS_TAC []);

Theorem HAS_INTEGRAL_LIM_SEQUENTIALLY :
    !f:real->real l.
           (f --> 0) at_posinfinity /\
           (!n. f integrable_on interval[0,&n]) /\
           ((\n:num. (integral (interval[0,&n]) f)) --> l) sequentially
           ==> (f has_integral l) {t | &0 <= t}
Proof
  REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[HAS_INTEGRAL_LIM_AT_POSINFINITY] THEN
  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
   [X_GEN_TAC ``a:real`` THEN MP_TAC(SPEC ``a:real`` SIMP_REAL_ARCH) THEN
    DISCH_THEN(X_CHOOSE_TAC ``n:num``) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``n:num``) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTEGRABLE_SUBINTERVAL) THEN
    REWRITE_TAC[SUBSET_INTERVAL, REAL_LE_REFL] THEN rw [],
    DISCH_TAC] THEN
  REWRITE_TAC[LIM_AT_POSINFINITY, real_ge] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  UNDISCH_TAC ``(f --> 0) at_posinfinity`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [LIM_AT_POSINFINITY]) THEN
  DISCH_THEN(MP_TAC o SPEC ``e / &2:real``) THEN
  ASM_REWRITE_TAC[REAL_HALF, o_THM, real_ge] THEN
  SIMP_TAC std_ss [DIST_0, LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC ``B:real`` THEN DISCH_TAC THEN
  UNDISCH_TAC ``((\n. integral (interval [(0,&n)]) f) --> l) sequentially`` THEN
  DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [LIM_SEQUENTIALLY]) THEN
  DISCH_THEN(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``max (&N) B + &1:real`` THEN
  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN MP_TAC(SPEC ``x:real`` FLOOR_POS) THEN
  KNOW_TAC ``0 <= x:real`` THENL
  [POP_ASSUM (MP_TAC o REWRITE_RULE [max_def]) THEN COND_CASES_TAC THEN STRIP_TAC THENL
   [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``B + 1:real`` THEN
    ASM_REWRITE_TAC [] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC ``B:real`` THEN REWRITE_TAC [REAL_ARITH ``B <= B + 1:real``] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``&N:real`` THEN
    ASM_REWRITE_TAC [REAL_POS], MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC ``&N + 1:real`` THEN ASM_REWRITE_TAC [] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``&N:real`` THEN
    ASM_REWRITE_TAC [REAL_POS] THEN REAL_ARITH_TAC],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  DISCH_THEN(X_CHOOSE_TAC ``n:num``) THEN
  SUBGOAL_THEN
   ``integral(interval[0,x]) (f:real->real) =
     integral(interval[0,&n]) f + integral(interval[&n,x]) f``
  SUBST1_TAC THENL
   [CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN
    ASM_REWRITE_TAC[REAL_POS] THEN
    POP_ASSUM (MP_TAC o REWRITE_RULE [GSYM REAL_OF_NUM_EQ] o SYM) THEN
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN MATCH_MP_TAC NUM_FLOOR_LE THEN
    UNDISCH_TAC ``max (&N) B + 1 <= x:real`` THEN REWRITE_TAC [max_def] THEN
    COND_CASES_TAC THEN STRIP_TAC THENL [MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC ``B + 1:real`` THEN
    ASM_REWRITE_TAC [] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC ``B:real`` THEN REWRITE_TAC [REAL_ARITH ``B <= B + 1:real``] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``&N:real`` THEN
    ASM_REWRITE_TAC [REAL_POS], MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC ``&N + 1:real`` THEN ASM_REWRITE_TAC [] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``&N:real`` THEN
    ASM_REWRITE_TAC [REAL_POS] THEN REAL_ARITH_TAC],
    ALL_TAC] THEN
  GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF] THEN REWRITE_TAC [dist] THEN
  MATCH_MP_TAC(REAL_ARITH
   ``abs(a:real - l) < e / &2 /\ abs b <= e / &2 ==>
     abs(a + b - l) < e / 2 + e / 2:real``) THEN
  REWRITE_TAC [GSYM dist] THEN CONJ_TAC THENL
   [FULL_SIMP_TAC std_ss [] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN
    POP_ASSUM (MP_TAC o REWRITE_RULE [GSYM REAL_OF_NUM_EQ] o SYM) THEN
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN KNOW_TAC ``0 <= x:real`` THENL
    [UNDISCH_TAC ``max (&N) B + 1 <= x:real`` THEN REWRITE_TAC [max_def] THEN
     COND_CASES_TAC THEN STRIP_TAC THENL
     [MATCH_MP_TAC REAL_LE_TRANS THEN
      EXISTS_TAC ``B + 1:real`` THEN
      ASM_REWRITE_TAC [] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
      EXISTS_TAC ``B:real`` THEN REWRITE_TAC [REAL_ARITH ``B <= B + 1:real``] THEN
      MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``&N:real`` THEN
      ASM_REWRITE_TAC [REAL_POS], MATCH_MP_TAC REAL_LE_TRANS THEN
      EXISTS_TAC ``&N + 1:real`` THEN ASM_REWRITE_TAC [] THEN
      MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``&N:real`` THEN
      ASM_REWRITE_TAC [REAL_POS] THEN REAL_ARITH_TAC],
     DISCH_TAC THEN ASM_SIMP_TAC std_ss [REAL_OF_NUM_LE, NUM_FLOOR_LE2]] THEN
     UNDISCH_TAC ``max (&N) B + 1 <= x:real`` THEN REWRITE_TAC [max_def] THEN
     Cases_on `&N <= B` >> rw []
     >- (MATCH_MP_TAC REAL_LE_TRANS >> Q.EXISTS_TAC `B` >> art [] \\
         POP_ASSUM MP_TAC >> REAL_ARITH_TAC) \\
     `B < &N` by PROVE_TAC [real_lte] \\
     MATCH_MP_TAC REAL_LE_TRANS >> Q.EXISTS_TAC `&(N + 1)` >> art [] \\
     fs [], ALL_TAC] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
    ``(integral(interval[&n:real,x]) (\x. (e / &2)))`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC INTEGRAL_ABS_BOUND_INTEGRAL THEN
    ASM_REWRITE_TAC[INTEGRABLE_CONST, IN_INTERVAL] THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN
      EXISTS_TAC ``interval[0:real,x]`` THEN
      ASM_REWRITE_TAC[SUBSET_INTERVAL] THEN REWRITE_TAC [REAL_LE_REFL, REAL_POS],
      REPEAT STRIP_TAC THEN
      MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      UNDISCH_TAC ``max (&N) B + 1 <= x:real`` THEN REWRITE_TAC [max_def] THEN
      COND_CASES_TAC THEN STRIP_TAC THENL
      [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``x - 1:real`` THEN
       CONJ_TAC THENL [POP_ASSUM MP_TAC THEN REAL_ARITH_TAC, ALL_TAC] THEN
       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``&n:real`` THEN
       ASM_REWRITE_TAC [] THEN
       MATCH_MP_TAC (REAL_ARITH ``x < b + 1 ==> (x - 1 <= b:real)``) THEN
       REWRITE_TAC [GSYM NUM_FLOOR_LET] THEN ASM_SIMP_TAC std_ss [REAL_LE_LT],
       FULL_SIMP_TAC std_ss [REAL_NOT_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
       EXISTS_TAC ``&n:real`` THEN ASM_REWRITE_TAC [] THEN
       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``&N:real`` THEN
       ASM_REWRITE_TAC [REAL_LE_LT] THEN SIMP_TAC real_ss [GSYM REAL_LE_LT] THEN
       UNDISCH_TAC ``flr x = n:num`` THEN DISCH_THEN
        (fn th => REWRITE_TAC [ONCE_REWRITE_RULE [EQ_SYM_EQ] th]) THEN
       KNOW_TAC ``0 <= x:real`` THENL
       [MATCH_MP_TAC REAL_LE_TRANS THEN
        EXISTS_TAC ``&N + 1:real`` THEN ASM_REWRITE_TAC [] THEN
        MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``&N:real`` THEN
        ASM_REWRITE_TAC [REAL_POS] THEN REAL_ARITH_TAC, DISCH_TAC] THEN
       ASM_SIMP_TAC std_ss [NUM_FLOOR_LE2] THEN UNDISCH_TAC ``&N + 1 <= x:real`` THEN
       REAL_ARITH_TAC]],
     REWRITE_TAC[INTEGRAL_CONST] THEN KNOW_TAC ``0 <= x:real`` THENL
     [UNDISCH_TAC ``max (&N) B + 1 <= x:real`` THEN REWRITE_TAC [max_def] THEN
      COND_CASES_TAC THEN STRIP_TAC THENL
      [MATCH_MP_TAC REAL_LE_TRANS THEN
       EXISTS_TAC ``B + 1:real`` THEN
       ASM_REWRITE_TAC [] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
       EXISTS_TAC ``B:real`` THEN REWRITE_TAC [REAL_ARITH ``B <= B + 1:real``] THEN
       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``&N:real`` THEN
       ASM_REWRITE_TAC [REAL_POS], MATCH_MP_TAC REAL_LE_TRANS THEN
       EXISTS_TAC ``&N + 1:real`` THEN ASM_REWRITE_TAC [] THEN
       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``&N:real`` THEN
       ASM_REWRITE_TAC [REAL_POS] THEN REAL_ARITH_TAC], DISCH_TAC] THEN
    FIRST_ASSUM (MP_TAC o MATCH_MP NUM_FLOOR_LE) THEN
    RULE_ASSUM_TAC (REWRITE_RULE [GSYM REAL_OF_NUM_EQ]) THEN ASM_REWRITE_TAC [] THEN
    DISCH_TAC THEN ASM_SIMP_TAC real_ss [CONTENT_CLOSED_INTERVAL] THEN
    GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
    MATCH_MP_TAC REAL_LE_RMUL_IMP THEN ASM_REWRITE_TAC [REAL_HALF, REAL_LE_LT] THEN
    REWRITE_TAC [GSYM REAL_LE_LT] THEN
    MATCH_MP_TAC (REAL_ARITH ``x < &n + 1 ==> x - &n <= 1:real``) THEN
    REWRITE_TAC [GSYM NUM_FLOOR_LET] THEN REWRITE_TAC [GSYM REAL_OF_NUM_LE] THEN
    ASM_SIMP_TAC std_ss [REAL_LE_LT]]
QED

(* ------------------------------------------------------------------------- *)
(* Interval functions of bounded variation on a set.                         *)
(* ------------------------------------------------------------------------- *)

val _ = set_fixity "has_bounded_setvariation_on" (Infix(NONASSOC, 450));

val set_variation = new_definition ("set_variation",
 ``set_variation s (f:(real->bool)->real) =
        sup { sum d (\k. abs(f k)) | ?t. d division_of t /\ t SUBSET s}``);

val has_bounded_setvariation_on = new_definition ("has_bounded_setvariation_on",
  ``(f:(real->bool)->real) has_bounded_setvariation_on s <=>
        ?B. !d t. d division_of t /\ t SUBSET s
                  ==> sum d (\k. abs(f k)) <= B``);

val HAS_BOUNDED_SETVARIATION_ON = store_thm ("HAS_BOUNDED_SETVARIATION_ON",
 ``!f:(real->bool)->real s.
        f  has_bounded_setvariation_on s <=>
        ?B. &0 < B /\ !d t. d division_of t /\ t SUBSET s
                            ==> sum d (\k. abs(f k)) <= B``,
  REWRITE_TAC[has_bounded_setvariation_on] THEN
  MESON_TAC[REAL_ARITH ``&0 < abs B + &1 /\ (x <= B ==> x <= abs B + &1:real)``]);

val HAS_BOUNDED_SETVARIATION_ON_EQ = store_thm ("HAS_BOUNDED_SETVARIATION_ON_EQ",
 ``!f g:(real->bool)->real s.
        (!a b. ~(interval[a,b] = {}) /\ interval[a,b] SUBSET s
               ==> (f(interval[a,b]) = g(interval[a,b]))) /\
        f has_bounded_setvariation_on s
        ==> g has_bounded_setvariation_on s``,
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  REWRITE_TAC[has_bounded_setvariation_on] THEN
  DISCH_THEN (X_CHOOSE_TAC ``B:real``) THEN EXISTS_TAC ``B:real`` THEN
  POP_ASSUM MP_TAC THEN DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN
  POP_ASSUM (MP_TAC o SPECL [``d:(real->bool)->bool``,``t:real->bool``]) THEN
  DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC(REAL_ARITH ``(x = y) ==> x <= B ==> y <= B:real``) THEN
  MATCH_MP_TAC SUM_EQ THEN UNDISCH_TAC ``d division_of t`` THEN
  DISCH_TAC THEN FIRST_ASSUM(fn th =>
  ONCE_REWRITE_TAC [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN
  REPEAT STRIP_TAC THEN SIMP_TAC std_ss [] THEN AP_TERM_TAC THEN
  METIS_TAC[division_of, SUBSET_TRANS]);

val SET_VARIATION_EQ = store_thm ("SET_VARIATION_EQ",
 ``!f g:(real->bool)->real s.
        (!a b. ~(interval[a,b] = {}) /\ interval[a,b] SUBSET s
               ==> (f(interval[a,b]) = g(interval[a,b])))
        ==> (set_variation s f = set_variation s g)``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[set_variation] THEN AP_TERM_TAC THEN
  ONCE_REWRITE_TAC [METIS []
   ``{sum d (\k. abs (f k)) | ?t. d division_of t /\ t SUBSET s} =
     {(\d. sum d (\k. abs (f k))) d | (\d. ?t. d division_of t /\ t SUBSET s) d}``] THEN
  MATCH_MP_TAC(SET_RULE
   ``(!x. P x ==> (f x = g x)) ==> ({f x | P x} = {g x | P x})``) THEN
  X_GEN_TAC ``d:(real->bool)->bool`` THEN SIMP_TAC std_ss [] THEN
  DISCH_THEN(X_CHOOSE_THEN ``t:real->bool`` STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC SUM_EQ THEN UNDISCH_TAC ``d division_of t`` THEN
  DISCH_TAC THEN FIRST_ASSUM(fn th =>
  ONCE_REWRITE_TAC [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN
  REPEAT STRIP_TAC THEN SIMP_TAC std_ss [] THEN AP_TERM_TAC THEN
  METIS_TAC[division_of, SUBSET_TRANS]);

val HAS_BOUNDED_SETVARIATION_ON_COMPONENTWISE = store_thm ("HAS_BOUNDED_SETVARIATION_ON_COMPONENTWISE",
 ``!f:(real->bool)->real s.
        f has_bounded_setvariation_on s <=>
            (\k. f k) has_bounded_setvariation_on s``,
  METIS_TAC []);

val HAS_BOUNDED_SETVARIATION_COMPARISON = store_thm ("HAS_BOUNDED_SETVARIATION_COMPARISON",
 ``!f:(real->bool)->real g:(real->bool)->real s.
        f has_bounded_setvariation_on s /\
        (!a b. ~(interval[a,b] = {}) /\ interval[a,b] SUBSET s
               ==> abs(g(interval[a,b])) <= abs(f(interval[a,b])))
        ==> g has_bounded_setvariation_on s``,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  REWRITE_TAC[has_bounded_setvariation_on] THEN
  DISCH_THEN (X_CHOOSE_TAC ``B:real``) THEN EXISTS_TAC ``B:real`` THEN
  GEN_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o SPECL
   [``d:(real -> bool) -> bool``,``t:real -> bool``]) THEN
  DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
  MATCH_MP_TAC SUM_LE THEN
  CONJ_TAC THENL [ASM_MESON_TAC[division_of], ALL_TAC] THEN
  SIMP_TAC std_ss [] THEN METIS_TAC[division_of, SUBSET_TRANS]);

val HAS_BOUNDED_SETVARIATION_ON_ABS = store_thm ("HAS_BOUNDED_SETVARIATION_ON_ABS",
 ``!f:(real->bool)->real s.
        (\x. (abs(f x))) has_bounded_setvariation_on s <=>
        (\x. (f x)) has_bounded_setvariation_on s``,
  REWRITE_TAC[has_bounded_setvariation_on] THEN
  SIMP_TAC std_ss [ABS_ABS]);

val SETVARIATION_EQUAL_LEMMA = store_thm ("SETVARIATION_EQUAL_LEMMA",
 ``!mf:((real->bool)->real)->((real->bool)->real) ms ms'.
        (!s. (ms'(ms s) = s) /\ (ms(ms' s) = s)) /\
        (!f a b. ~(interval[a,b] = {})
                 ==> (mf f (ms (interval[a,b])) = f (interval[a,b])) /\
                     ?a' b'. ~(interval[a',b'] = {}) /\
                             (ms' (interval[a,b]) = interval[a',b'])) /\
        (!t u. t SUBSET u ==> ms t SUBSET ms u /\ ms' t SUBSET ms' u) /\
        (!d t. d division_of t
               ==> (IMAGE ms d) division_of ms t /\
                   (IMAGE ms' d) division_of ms' t)
   ==> (!f s. (mf f) has_bounded_setvariation_on (ms s) <=>
              f has_bounded_setvariation_on s) /\
       (!f s. set_variation (ms s) (mf f) = set_variation s f)``,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  REWRITE_TAC[has_bounded_setvariation_on, set_variation] THEN
  KNOW_TAC `` ((!(f :(real -> bool) -> real) (s :real -> bool).
  ({sum d (\(k :real -> bool). abs (mf f k)) |
     ?(t :real -> bool). d division_of t /\ t SUBSET ms s} =
   {sum d (\(k :real -> bool). abs (f k)) |
     ?(t :real -> bool). d division_of t /\ t SUBSET s})) ==>
  (!(f :(real -> bool) -> real) (s :real -> bool).
   (?(B :real).
      !(d :(real -> bool) -> bool) (t :real -> bool).
        d division_of t /\
        t SUBSET (ms :(real -> bool) -> real -> bool) s ==>
        sum d (\(k :real -> bool).
         abs ((mf :((real->bool)->real)->(real->bool)->real) f k)) <= B) <=>
   ?(B :real).
     !(d :(real -> bool) -> bool) (t :real -> bool).
       d division_of t /\ t SUBSET s ==>
       sum d (\(k :real -> bool). abs (f k)) <= B)) /\
  (!(f :(real -> bool) -> real) (s :real -> bool).
  ({sum d (\(k :real -> bool). abs (mf f k)) |
     ?(t :real -> bool). d division_of t /\ t SUBSET ms s} =
   {sum d (\(k :real -> bool). abs (f k)) |
     ?(t :real -> bool). d division_of t /\ t SUBSET s}))`` THENL
  [ALL_TAC, METIS_TAC []] THEN CONJ_TAC THENL
   [SIMP_TAC std_ss [EXTENSION, GSPECIFICATION] THEN
    METIS_TAC [], ALL_TAC] THEN
  SIMP_TAC std_ss [EXTENSION, GSPECIFICATION] THEN REPEAT GEN_TAC THEN EQ_TAC THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC [CONJ_SYM] THENL
   [EXISTS_TAC ``IMAGE (ms':(real->bool)->real->bool) d``,
    EXISTS_TAC ``IMAGE (ms:(real->bool)->real->bool) d``] THENL
  [CONJ_TAC THENL [METIS_TAC[], ALL_TAC] THEN
   W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE o rand o snd) THEN
   KNOW_TAC ``(!(x :real -> bool) (y :real -> bool).
    x IN (d :(real -> bool) -> bool) /\ y IN d /\
    ((ms' :(real -> bool) -> real -> bool) x = ms' y) ==>
    (x = y))`` THENL
    [ASM_MESON_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
     POP_ASSUM K_TAC THEN DISCH_THEN SUBST1_TAC],
    CONJ_TAC THENL [METIS_TAC[], ALL_TAC] THEN
   W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE o rand o snd) THEN
   KNOW_TAC ``(!(x :real -> bool) (y :real -> bool).
    x IN (d :(real -> bool) -> bool) /\ y IN d /\
    ((ms :(real -> bool) -> real -> bool) x = ms y) ==>
    (x = y))`` THENL
    [ASM_MESON_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
     POP_ASSUM K_TAC THEN DISCH_THEN SUBST1_TAC]] THEN
  MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[o_THM] THEN
  UNDISCH_TAC ``d division_of t`` THEN DISCH_TAC THEN FIRST_ASSUM
   (fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN STRIP_TAC THEN
  AP_TERM_TAC THEN ASM_SIMP_TAC std_ss [] THEN
  SUBGOAL_THEN ``?a' b':real. ~(interval[a',b'] = {}) /\
                        (ms' (interval[a:real,b]) = interval[a',b'])``
  STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[], ALL_TAC] THEN
  ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);

val HAS_BOUNDED_SETVARIATION_ON_ELEMENTARY = store_thm ("HAS_BOUNDED_SETVARIATION_ON_ELEMENTARY",
 ``!f:(real->bool)->real s.
        (?d. d division_of s)
        ==> (f has_bounded_setvariation_on s <=>
             ?B. !d. d division_of s ==> sum d (\k. abs(f k)) <= B)``,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  REWRITE_TAC[has_bounded_setvariation_on] THEN EQ_TAC THEN
  DISCH_THEN (X_CHOOSE_TAC ``B:real``) THEN EXISTS_TAC ``B:real`` THEN
  POP_ASSUM MP_TAC THENL [MESON_TAC[SUBSET_REFL], ALL_TAC] THEN
  DISCH_TAC THEN
  MAP_EVERY X_GEN_TAC [``d:(real->bool)->bool``, ``t:real->bool``] THEN
  STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_TAC ``d':(real->bool)->bool``) THEN
  MP_TAC(ISPECL [``d:(real->bool)->bool``, ``d':(real->bool)->bool``,
             ``t:real->bool``, ``s:real->bool``] PARTIAL_DIVISION_EXTEND) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_TAC ``d'':(real->bool)->bool``) THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC ``sum d'' (\k:real->bool. abs(f k:real))`` THEN
  ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
  ASM_SIMP_TAC std_ss [ABS_POS] THEN ASM_MESON_TAC[DIVISION_OF_FINITE]);

val HAS_BOUNDED_SETVARIATION_ON_INTERVAL = store_thm ("HAS_BOUNDED_SETVARIATION_ON_INTERVAL",
 ``!f:(real->bool)->real a b.
        f has_bounded_setvariation_on interval[a,b] <=>
        ?B. !d. d division_of interval[a,b] ==> sum d (\k. abs(f k)) <= B``,
  REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_BOUNDED_SETVARIATION_ON_ELEMENTARY THEN
  REWRITE_TAC[ELEMENTARY_INTERVAL]);

val HAS_BOUNDED_SETVARIATION_ON_UNIV = store_thm ("HAS_BOUNDED_SETVARIATION_ON_UNIV",
 ``!f:(real->bool)->real.
        f has_bounded_setvariation_on univ(:real) <=>
        ?B. !d. d division_of BIGUNION d ==> sum d (\k. abs(f k)) <= B``,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[has_bounded_setvariation_on, SUBSET_UNIV] THEN
  MESON_TAC[DIVISION_OF_UNION_SELF]);

val HAS_BOUNDED_SETVARIATION_ON_SUBSET = store_thm ("HAS_BOUNDED_SETVARIATION_ON_SUBSET",
 ``!f:(real->bool)->real s t.
        f has_bounded_setvariation_on s /\ t SUBSET s
        ==> f has_bounded_setvariation_on t``,
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  REWRITE_TAC[has_bounded_setvariation_on] THEN
  METIS_TAC[SUBSET_TRANS]);

Theorem HAS_BOUNDED_SETVARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS :
    !f:(real->bool)->real s.
        f has_bounded_setvariation_on s
        ==> bounded { f(interval[c,d]) | interval[c,d] SUBSET s}
Proof
    rpt GEN_TAC >> REWRITE_TAC[has_bounded_setvariation_on, bounded_def]
 >> DISCH_THEN (X_CHOOSE_TAC ``B:real``)
 >> EXISTS_TAC ``max (abs B) (abs((f:(real->bool)->real) {}))``
 >> SIMP_TAC std_ss [FORALL_IN_GSPEC]
 >> MAP_EVERY X_GEN_TAC [``c:real``, ``d:real``] THEN DISCH_TAC
 >> ASM_CASES_TAC ``interval[c:real,d] = {}`` (* 2 subgoals *)
 >> ASM_REWRITE_TAC [REAL_LE_MAX2]
 >> FIRST_X_ASSUM (MP_TAC o SPECL
   [``{interval[c:real,d]}``, ``interval[c:real,d]``])
 >> ASM_SIMP_TAC std_ss [DIVISION_OF_SELF, SUM_SING, max_def]
 >> DISCH_TAC
 >> reverse (Cases_on `abs B <= abs (f {})`) >> fs []
 >- (MATCH_MP_TAC REAL_LE_TRANS \\
     Q.EXISTS_TAC `B` >> art [ABS_LE])
 >> MATCH_MP_TAC REAL_LE_TRANS
 >> Q.EXISTS_TAC `B` >> art []
 >> MATCH_MP_TAC REAL_LE_TRANS
 >> Q.EXISTS_TAC `abs B` >> art [ABS_LE]
QED

val HAS_BOUNDED_SETVARIATION_ON_ABS = store_thm ("HAS_BOUNDED_SETVARIATION_ON_ABS",
 ``!f:(real->bool)->real s.
        (\x. (abs(f x))) has_bounded_setvariation_on s <=>
        f has_bounded_setvariation_on s``,
  REWRITE_TAC[has_bounded_setvariation_on] THEN
  SIMP_TAC std_ss [ABS_ABS]);

val HAS_BOUNDED_SETVARIATION_ON_COMPOSE_LINEAR = store_thm ("HAS_BOUNDED_SETVARIATION_ON_COMPOSE_LINEAR",
 ``!f:(real->bool)->real g:real->real s.
        f has_bounded_setvariation_on s /\ linear g
        ==> (g o f) has_bounded_setvariation_on s``,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON] THEN
  DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC ``B:real``) ASSUME_TAC) THEN
  FIRST_X_ASSUM(X_CHOOSE_TAC ``C:real`` o MATCH_MP LINEAR_BOUNDED_POS) THEN
  EXISTS_TAC ``B * C:real`` THEN ASM_SIMP_TAC std_ss [REAL_LT_MUL] THEN
  MAP_EVERY X_GEN_TAC [``d:(real->bool)->bool``, ``t:real->bool``] THEN
  STRIP_TAC THEN REWRITE_TAC[o_THM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC ``sum d (\k. C * abs((f:(real->bool)->real) k))`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC SUM_LE THEN ASM_MESON_TAC[DIVISION_OF_FINITE],
    GEN_REWR_TAC RAND_CONV [REAL_MUL_SYM] THEN
    SIMP_TAC std_ss [SUM_LMUL] THEN ASM_SIMP_TAC std_ss [REAL_LE_LMUL] THEN
    ASM_MESON_TAC[]]);

val HAS_BOUNDED_SETVARIATION_ON_0 = store_thm ("HAS_BOUNDED_SETVARIATION_ON_0",
 ``!s:real->bool. (\x. 0) has_bounded_setvariation_on s``,
  REWRITE_TAC[has_bounded_setvariation_on, ABS_0, SUM_0] THEN
  MESON_TAC[REAL_LE_REFL]);

val SET_VARIATION_0 = store_thm ("SET_VARIATION_0",
 ``!s:real->bool. set_variation s (\x. 0) = &0``,
  GEN_TAC THEN REWRITE_TAC[set_variation, ABS_0, SUM_0] THEN
  GEN_REWR_TAC RAND_CONV [GSYM SUP_SING] THEN
  AP_TERM_TAC THEN SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, IN_SING] THEN
  MESON_TAC[ELEMENTARY_EMPTY, EMPTY_SUBSET]);

val HAS_BOUNDED_SETVARIATION_ON_CMUL = store_thm ("HAS_BOUNDED_SETVARIATION_ON_CMUL",
 ``!f:(real->bool)->real c s.
        f has_bounded_setvariation_on s
        ==> (\x. c * f x) has_bounded_setvariation_on s``,
  REPEAT GEN_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT, o_DEF]
     HAS_BOUNDED_SETVARIATION_ON_COMPOSE_LINEAR) THEN
  REWRITE_TAC[linear] THEN REAL_ARITH_TAC);

val HAS_BOUNDED_SETVARIATION_ON_NEG = store_thm ("HAS_BOUNDED_SETVARIATION_ON_NEG",
 ``!f:(real->bool)->real s.
        (\x. -(f x)) has_bounded_setvariation_on s <=>
        f has_bounded_setvariation_on s``,
  SIMP_TAC std_ss [has_bounded_setvariation_on, ABS_NEG]);

val HAS_BOUNDED_SETVARIATION_ON_ADD = store_thm ("HAS_BOUNDED_SETVARIATION_ON_ADD",
 ``!f:(real->bool)->real g s.
        f has_bounded_setvariation_on s /\
        g has_bounded_setvariation_on s
        ==> (\x. f x + g x) has_bounded_setvariation_on s``,
  REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_setvariation_on] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC)
   (X_CHOOSE_THEN ``C:real`` STRIP_ASSUME_TAC)) THEN
  EXISTS_TAC ``B + C:real`` THEN
  MAP_EVERY X_GEN_TAC [``d:(real->bool)->bool``, ``t:real->bool``] THEN
  STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC ``sum d (\k. abs((f:(real->bool)->real) k)) +
               sum d (\k. abs((g:(real->bool)->real) k))`` THEN
  CONJ_TAC THENL [ALL_TAC, ASM_MESON_TAC[REAL_LE_ADD2]] THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
  ASM_SIMP_TAC std_ss [GSYM SUM_ADD] THEN
  MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC std_ss [ABS_TRIANGLE]);

val HAS_BOUNDED_SETVARIATION_ON_SUB = store_thm ("HAS_BOUNDED_SETVARIATION_ON_SUB",
 ``!f:(real->bool)->real g s.
        f has_bounded_setvariation_on s /\
        g has_bounded_setvariation_on s
        ==> (\x. f x - g x) has_bounded_setvariation_on s``,
  REWRITE_TAC[REAL_ARITH ``x - y:real = x + -y``] THEN
  SIMP_TAC std_ss [HAS_BOUNDED_SETVARIATION_ON_ADD, HAS_BOUNDED_SETVARIATION_ON_NEG]);

val HAS_BOUNDED_SETVARIATION_ON_NULL = store_thm ("HAS_BOUNDED_SETVARIATION_ON_NULL",
 ``!f:(real->bool)->real s.
        (!a b. (content(interval[a,b]) = &0) ==> (f(interval[a,b]) = 0)) /\
        (content s = &0) /\ bounded s
        ==> f has_bounded_setvariation_on s``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_setvariation_on] THEN
  EXISTS_TAC ``&0:real`` THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC(REAL_ARITH ``(x = &0) ==> x <= &0:real``) THEN
  MATCH_MP_TAC SUM_EQ_0 THEN SIMP_TAC std_ss [ABS_ZERO] THEN
  UNDISCH_TAC ``d division_of t`` THEN DISCH_TAC THEN
  FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
  REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
  MATCH_MP_TAC CONTENT_0_SUBSET_GEN THEN
  EXISTS_TAC ``s:real->bool`` THEN ASM_REWRITE_TAC[] THEN
  ASM_MESON_TAC[division_of, SUBSET_TRANS]);

val SET_VARIATION_ELEMENTARY_LEMMA = store_thm ("SET_VARIATION_ELEMENTARY_LEMMA",
 ``!f:(real->bool)->real s b.
        (?d. d division_of s)
        ==> ((!d t. d division_of t /\ t SUBSET s
                    ==> sum d (\k. abs(f k)) <= b) <=>
             (!d. d division_of s ==> sum d (\k. abs(f k)) <= b))``,
  REPEAT GEN_TAC THEN DISCH_THEN(X_CHOOSE_TAC ``d1:(real->bool)->bool``) THEN
  EQ_TAC THENL [MESON_TAC[SUBSET_REFL], ALL_TAC] THEN
  DISCH_TAC THEN X_GEN_TAC ``d2:(real->bool)->bool`` THEN
  X_GEN_TAC ``t:real->bool`` THEN STRIP_TAC THEN MP_TAC(ISPECL
   [``d2:(real->bool)->bool``, ``d1:(real->bool)->bool``,
    ``t:real->bool``, ``s:real->bool``] PARTIAL_DIVISION_EXTEND) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_TAC ``d3:(real->bool)->bool``) THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC ``sum d3 (\k:real->bool. abs(f k:real))`` THEN
  ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
  ASM_SIMP_TAC std_ss [ABS_POS] THEN ASM_MESON_TAC[DIVISION_OF_FINITE]);

val SET_VARIATION_ON_ELEMENTARY = store_thm ("SET_VARIATION_ON_ELEMENTARY",
 ``!f:(real->bool)->real s.
        (?d. d division_of s)
        ==> (set_variation s f =
             sup { sum d (\k. abs(f k)) | d division_of s})``,
  REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[set_variation, sup_alt] THEN
  SIMP_TAC std_ss [FORALL_IN_GSPEC, LEFT_IMP_EXISTS_THM] THEN
  ASM_SIMP_TAC std_ss [SET_VARIATION_ELEMENTARY_LEMMA]);

val SET_VARIATION_ON_INTERVAL = store_thm ("SET_VARIATION_ON_INTERVAL",
 ``!f:(real->bool)->real a b.
        set_variation (interval[a,b]) f =
        sup { sum d (\k. abs(f k)) | d division_of interval[a,b]}``,
  REPEAT GEN_TAC THEN MATCH_MP_TAC SET_VARIATION_ON_ELEMENTARY THEN
  REWRITE_TAC[ELEMENTARY_INTERVAL]);

val HAS_BOUNDED_SETVARIATION_WORKS = store_thm ("HAS_BOUNDED_SETVARIATION_WORKS",
 ``!f:(real->bool)->real s.
        f has_bounded_setvariation_on s
        ==> (!d t. d division_of t /\ t SUBSET s
                   ==> sum d (\k. abs(f k)) <= set_variation s f) /\
            (!B. (!d t. d division_of t /\ t SUBSET s
                        ==> sum d (\k. abs (f k)) <= B)
                 ==> set_variation s f <= B)``,
  REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_setvariation_on] THEN
  DISCH_TAC THEN
  MP_TAC(ISPEC ``{ sum d (\k. abs((f:(real->bool)->real) k)) |
                  ?t. d division_of t /\ t SUBSET s}``
         SUP) THEN
  SIMP_TAC std_ss [FORALL_IN_GSPEC, LEFT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[set_variation] THEN DISCH_THEN MATCH_MP_TAC THEN
  ASM_SIMP_TAC std_ss [GSYM MEMBER_NOT_EMPTY, GSPECIFICATION] THEN
  MAP_EVERY EXISTS_TAC [``{}:(real->bool)->bool``] THEN
  REWRITE_TAC[SUM_CLAUSES] THEN EXISTS_TAC ``{}:real->bool`` THEN
  SIMP_TAC std_ss [division_of, EMPTY_SUBSET, NOT_IN_EMPTY, FINITE_EMPTY,
                   BIGUNION_EMPTY]);

val HAS_BOUNDED_SETVARIATION_WORKS_ON_ELEMENTARY = store_thm ("HAS_BOUNDED_SETVARIATION_WORKS_ON_ELEMENTARY",
 ``!f:(real->bool)->real s.
        f has_bounded_setvariation_on s /\ (?d. d division_of s)
        ==> (!d. d division_of s
                 ==> sum d (\k. abs(f k)) <= set_variation s f) /\
            (!B. (!d. d division_of s ==> sum d (\k. abs(f k)) <= B)
                 ==> set_variation s f <= B)``,
  SIMP_TAC std_ss [GSYM SET_VARIATION_ELEMENTARY_LEMMA] THEN
  METIS_TAC[HAS_BOUNDED_SETVARIATION_WORKS]);

val HAS_BOUNDED_SETVARIATION_WORKS_ON_INTERVAL = store_thm ("HAS_BOUNDED_SETVARIATION_WORKS_ON_INTERVAL",
 ``!f:(real->bool)->real a b.
      f has_bounded_setvariation_on interval[a,b]
      ==> (!d. d division_of interval[a,b]
               ==> sum d (\k. abs(f k)) <= set_variation (interval[a,b]) f) /\
          (!B. (!d. d division_of interval[a,b]
                    ==> sum d (\k. abs(f k)) <= B)
               ==> set_variation (interval[a,b]) f <= B)``,
  SIMP_TAC std_ss [HAS_BOUNDED_SETVARIATION_WORKS_ON_ELEMENTARY, ELEMENTARY_INTERVAL]);

val SET_VARIATION_UBOUND = store_thm ("SET_VARIATION_UBOUND",
 ``!f:(real->bool)->real s B.
        f has_bounded_setvariation_on s /\
        (!d t. d division_of t /\ t SUBSET s ==> sum d (\k. abs(f k)) <= B)
        ==> set_variation s f <= B``,
  METIS_TAC[HAS_BOUNDED_SETVARIATION_WORKS]);

val SET_VARIATION_UBOUND_ON_INTERVAL = store_thm ("SET_VARIATION_UBOUND_ON_INTERVAL",
 ``!f:(real->bool)->real a b B.
        f has_bounded_setvariation_on interval[a,b] /\
        (!d. d division_of interval[a,b] ==> sum d (\k. abs(f k)) <= B)
        ==> set_variation (interval[a,b]) f <= B``,
  SIMP_TAC std_ss [GSYM SET_VARIATION_ELEMENTARY_LEMMA, ELEMENTARY_INTERVAL] THEN
  METIS_TAC[SET_VARIATION_UBOUND]);

val SET_VARIATION_LBOUND = store_thm ("SET_VARIATION_LBOUND",
 ``!f:(real->bool)->real s B.
        f has_bounded_setvariation_on s /\
        (?d t. d division_of t /\ t SUBSET s /\ B <= sum d (\k. abs(f k)))
        ==> B <= set_variation s f``,
  METIS_TAC[HAS_BOUNDED_SETVARIATION_WORKS, REAL_LE_TRANS]);

val SET_VARIATION_LBOUND_ON_INTERVAL = store_thm ("SET_VARIATION_LBOUND_ON_INTERVAL",
 ``!f:(real->bool)->real a b B.
        f has_bounded_setvariation_on interval[a,b] /\
        (?d. d division_of interval[a,b] /\ B <= sum d (\k. abs(f k)))
        ==> B <= set_variation (interval[a,b]) f``,
  METIS_TAC[HAS_BOUNDED_SETVARIATION_WORKS_ON_INTERVAL, REAL_LE_TRANS]);

val SET_VARIATION = store_thm ("SET_VARIATION",
 ``!f:(real->bool)->real s d t.
        f has_bounded_setvariation_on s /\ d division_of t /\ t SUBSET s
        ==> sum d (\k. abs(f k)) <= set_variation s f``,
  METIS_TAC[HAS_BOUNDED_SETVARIATION_WORKS]);

val SET_VARIATION_WORKS_ON_INTERVAL = store_thm ("SET_VARIATION_WORKS_ON_INTERVAL",
 ``!f:(real->bool)->real a b d.
        f has_bounded_setvariation_on interval[a,b] /\
        d division_of interval[a,b]
        ==> sum d (\k. abs(f k)) <= set_variation (interval[a,b]) f``,
  METIS_TAC[HAS_BOUNDED_SETVARIATION_WORKS_ON_INTERVAL]);

val SET_VARIATION_POS_LE = store_thm ("SET_VARIATION_POS_LE",
 ``!f:(real->bool)->real s.
        f has_bounded_setvariation_on s ==> &0 <= set_variation s f``,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SET_VARIATION)) THEN
  DISCH_THEN(MP_TAC o SPECL[``{}:(real->bool)->bool``, ``{}:real->bool``]) THEN
  REWRITE_TAC[EMPTY_SUBSET, SUM_CLAUSES, DIVISION_OF_TRIVIAL]);

val SET_VARIATION_COMPARISON = store_thm ("SET_VARIATION_COMPARISON",
 ``!f:(real->bool)->real g:(real->bool)->real s.
        f has_bounded_setvariation_on s /\
        (!a b. ~(interval[a,b] = {}) /\ interval[a,b] SUBSET s
               ==> abs(g(interval[a,b])) <= abs(f(interval[a,b])))
        ==> set_variation s g <= set_variation s f``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SET_VARIATION_UBOUND THEN CONJ_TAC THENL
   [ASM_MESON_TAC[HAS_BOUNDED_SETVARIATION_COMPARISON], ALL_TAC] THEN
  UNDISCH_TAC ``f has_bounded_setvariation_on s`` THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o CONJUNCT1 o MATCH_MP
   HAS_BOUNDED_SETVARIATION_WORKS) THEN
  DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN
  POP_ASSUM (MP_TAC o SPECL [``d:(real -> bool) -> bool``,``t:real -> bool``]) THEN
  DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
  MATCH_MP_TAC SUM_LE THEN
  CONJ_TAC THENL [ASM_MESON_TAC[division_of], ALL_TAC] THEN
  UNDISCH_TAC ``d division_of t`` THEN DISCH_TAC THEN FIRST_ASSUM
   (fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  METIS_TAC[division_of, SUBSET_TRANS]);

val SET_VARIATION_GE_FUNCTION = store_thm ("SET_VARIATION_GE_FUNCTION",
 ``!f:(real->bool)->real s a b.
        f has_bounded_setvariation_on s /\
        interval[a,b] SUBSET s /\ ~(interval[a,b] = {})
        ==> abs(f(interval[a,b])) <= set_variation s f``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SET_VARIATION_LBOUND THEN
  ASM_SIMP_TAC std_ss [] THEN EXISTS_TAC ``{interval[a:real,b]}`` THEN
  EXISTS_TAC ``interval[a:real,b]`` THEN
  ASM_SIMP_TAC std_ss [SUM_SING, REAL_LE_REFL] THEN
  ASM_SIMP_TAC std_ss [DIVISION_OF_SELF]);

val SET_VARIATION_ON_NULL = store_thm ("SET_VARIATION_ON_NULL",
 ``!f:(real->bool)->real s.
        (!a b. (content(interval[a,b]) = &0) ==> (f(interval[a,b]) = 0)) /\
        (content s = &0) /\ bounded s
        ==> (set_variation s f = &0)``,
  REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL
   [MATCH_MP_TAC SET_VARIATION_UBOUND THEN
    ASM_SIMP_TAC std_ss [HAS_BOUNDED_SETVARIATION_ON_NULL] THEN
    REPEAT STRIP_TAC THEN
    MATCH_MP_TAC(REAL_ARITH ``(x = &0) ==> x <= &0:real``) THEN
    MATCH_MP_TAC SUM_EQ_0 THEN SIMP_TAC std_ss [ABS_ZERO] THEN
    UNDISCH_TAC ``d division_of t`` THEN DISCH_TAC THEN
    FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
    REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    MATCH_MP_TAC CONTENT_0_SUBSET_GEN THEN
    EXISTS_TAC ``s:real->bool`` THEN ASM_REWRITE_TAC[] THEN
    ASM_MESON_TAC[division_of, SUBSET_TRANS],
    MATCH_MP_TAC SET_VARIATION_POS_LE THEN
    ASM_SIMP_TAC std_ss [HAS_BOUNDED_SETVARIATION_ON_NULL]]);

val SET_VARIATION_TRIANGLE = store_thm ("SET_VARIATION_TRIANGLE",
 ``!f:(real->bool)->real g s.
        f has_bounded_setvariation_on s /\
        g has_bounded_setvariation_on s
        ==> set_variation s (\x. f x + g x)
             <= set_variation s f + set_variation s g``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SET_VARIATION_UBOUND THEN
  ASM_SIMP_TAC std_ss [HAS_BOUNDED_SETVARIATION_ON_ADD] THEN
  MAP_EVERY X_GEN_TAC [``d:(real->bool)->bool``, ``t:real->bool``] THEN
  STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC ``sum d (\k. abs((f:(real->bool)->real) k)) +
              sum d (\k. abs((g:(real->bool)->real) k))`` THEN
  CONJ_TAC THENL
   [FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
    ASM_SIMP_TAC std_ss [GSYM SUM_ADD] THEN
    MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC std_ss [ABS_TRIANGLE],
    MATCH_MP_TAC REAL_LE_ADD2 THEN
    CONJ_TAC THEN MATCH_MP_TAC SET_VARIATION THEN ASM_MESON_TAC[]]);

val HAS_BOUNDED_SETVARIATION_ON_SUM_AND_SET_VARIATION_SUM_LE = store_thm ("HAS_BOUNDED_SETVARIATION_ON_SUM_AND_SET_VARIATION_SUM_LE",
 ``(!f:'a->(real->bool)->real s k.
        FINITE k /\
        (!i. i IN k ==> f i has_bounded_setvariation_on s)
        ==> (\x. sum k (\i. f i x)) has_bounded_setvariation_on s) /\
   (!f:'a->(real->bool)->real s k.
        FINITE k /\
        (!i. i IN k ==> f i has_bounded_setvariation_on s)
        ==> set_variation s (\x. sum k (\i. f i x))
            <= sum k (\i. set_variation s (f i)))``,
  SIMP_TAC std_ss [GSYM FORALL_AND_THM, TAUT
   `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN
  GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
  ONCE_REWRITE_TAC [METIS []
   ``!k. ((!i. i IN k ==> f i has_bounded_setvariation_on s) ==>
         (\x. sum k (\i. f i x)) has_bounded_setvariation_on s /\
          set_variation s (\x. sum k (\i. f i x)) <=
          sum k (\i. set_variation s (f i))) =
    (\k. (!i. i IN k ==> f i has_bounded_setvariation_on s) ==>
         (\x. sum k (\i. f i x)) has_bounded_setvariation_on s /\
          set_variation s (\x. sum k (\i. f i x)) <=
          sum k (\i. set_variation s (f i))) k``] THEN
  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
  SIMP_TAC std_ss [SUM_CLAUSES, FORALL_IN_INSERT] THEN
  SIMP_TAC std_ss [SET_VARIATION_0, REAL_LE_REFL, HAS_BOUNDED_SETVARIATION_ON_0,
           HAS_BOUNDED_SETVARIATION_ON_ADD, ETA_AX] THEN
  REPEAT STRIP_TAC THENL
  [ONCE_REWRITE_TAC [METIS [] ``(\x. f e x + sum s' (\i. f i x)) =
                   (\x. (\x. f e x) x + (\x. sum s' (\i. f i x)) x)``] THEN
   MATCH_MP_TAC HAS_BOUNDED_SETVARIATION_ON_ADD THEN METIS_TAC [ETA_AX],
  ALL_TAC] THEN
  ONCE_REWRITE_TAC [METIS [] ``(\x. f e x + sum s' (\i. f i x)) =
                   (\x. (\x. f e x) x + (\x. sum s' (\i. f i x)) x)``] THEN
  W(MP_TAC o PART_MATCH (lhand o rand)
    SET_VARIATION_TRIANGLE o lhand o snd) THEN
  ASM_SIMP_TAC std_ss [METIS [ETA_AX] ``(\x. f e x) = f e``] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
  ASM_SIMP_TAC std_ss [REAL_LE_LADD]);

val HAS_BOUNDED_SETVARIATION_ON_SUM = store_thm ("HAS_BOUNDED_SETVARIATION_ON_SUM",
 ``(!f:'a->(real->bool)->real s k.
        FINITE k /\
        (!i. i IN k ==> f i has_bounded_setvariation_on s)
        ==> (\x. sum k (\i. f i x)) has_bounded_setvariation_on s)``,
  REWRITE_TAC [HAS_BOUNDED_SETVARIATION_ON_SUM_AND_SET_VARIATION_SUM_LE]);

val SET_VARIATION_SUM_LE = store_thm ("SET_VARIATION_SUM_LE",
 ``(!f:'a->(real->bool)->real s k.
        FINITE k /\
        (!i. i IN k ==> f i has_bounded_setvariation_on s)
        ==> set_variation s (\x. sum k (\i. f i x))
            <= sum k (\i. set_variation s (f i)))``,
  REWRITE_TAC [HAS_BOUNDED_SETVARIATION_ON_SUM_AND_SET_VARIATION_SUM_LE]);

val lemma1 = prove (
   ``!f:(real->bool)->real B1 B2 a b.
      (!a b. (content(interval[a,b]) = &0) ==> (f(interval[a,b]) = &0)) /\
      (!a b c. f(interval[a,b]) <=
               f(interval[a,b] INTER {x | x <= c}) +
               f(interval[a,b] INTER {x | x >= c})) /\
      (!d. d division_of (interval[a,b] INTER {x | x <= c})
           ==> sum d f <= B1) /\
      (!d. d division_of (interval[a,b] INTER {x | x >= c})
           ==> sum d f <= B2)
      ==> !d. d division_of interval[a,b] ==> sum d f <= B1 + B2``,
    REPEAT GEN_TAC THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_TAC THEN
    GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC
     ``sum {l INTER {x:real | x <= c} | l | l IN d /\
                                        ~(l INTER {x | x <= c} = {})} f +
      sum {l INTER {x | x >= c} | l | l IN d /\
                                        ~(l INTER {x | x >= c} = {})} f`` THEN
    CONJ_TAC THENL
     [ALL_TAC,
      MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC std_ss [DIVISION_SPLIT]] THEN
    ONCE_REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN]
     ``{l INTER {x | x <= c:real} | l | l IN d /\ l INTER {x | x <= c} <> {}} =
       IMAGE (\l. l INTER {x | x <= c})
        {l | l IN d /\ l INTER {x | x <= c} <> {}}``] THEN
    ONCE_REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN]
     ``{l INTER {x | x >= c:real} | l | l IN d /\ l INTER {x | x >= c} <> {}} =
       IMAGE (\l. l INTER {x | x >= c})
        {l | l IN d /\ l INTER {x | x >= c} <> {}}``] THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
    W(fn (asl,w) =>
         MP_TAC(PART_MATCH (lhs o rand) SUM_IMAGE_NONZERO (lhand(rand w))) THEN
         MP_TAC(PART_MATCH (lhs o rand) SUM_IMAGE_NONZERO (rand(rand w)))) THEN
    MATCH_MP_TAC(TAUT
     `(a1 /\ a2) /\ (b1 /\ b2 ==> c)
      ==> (a1 ==> b1) ==> (a2 ==> b2) ==> c`) THEN
    CONJ_TAC THENL
     [ASM_SIMP_TAC std_ss [FINITE_RESTRICT, IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
      SIMP_TAC std_ss [FORALL_IN_GSPEC, IMP_CONJ] THEN
      UNDISCH_TAC ``d division_of interval [(a,b)]`` THEN DISCH_TAC THEN
      FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
      REPEAT STRIP_TAC THEN ASM_SIMP_TAC std_ss [INTERVAL_SPLIT] THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC std_ss [GSYM INTERVAL_SPLIT] THENL
       [MATCH_MP_TAC DIVISION_SPLIT_RIGHT_INJ,
        MATCH_MP_TAC DIVISION_SPLIT_LEFT_INJ] THEN
      ASM_MESON_TAC[],
      DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC)] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC
     ``sum d (f o (\l. l INTER {x | x <= c})) +
       sum d (f o (\l. l INTER {x:real | x >= c}))`` THEN
    CONJ_TAC THENL
     [ASM_SIMP_TAC std_ss [GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN
      ASM_REWRITE_TAC[o_THM] THEN
      UNDISCH_TAC ``d division_of interval [(a,b)]`` THEN DISCH_TAC THEN
      FIRST_ASSUM(fn th => ASM_SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]),
      MATCH_MP_TAC(REAL_ARITH ``(x = y) /\ (w = z) ==> x + w <= y + z:real``) THEN
      CONJ_TAC THEN MATCH_MP_TAC SUM_SUPERSET THEN
      ONCE_REWRITE_TAC [METIS [] ``({l | l IN d /\ l INTER {x | x <= c:real} <> {}}) =
                               {l | l IN d /\ (\l. l INTER {x | x <= c} <> {}) l}``] THEN
      ONCE_REWRITE_TAC [METIS [] ``({l | l IN d /\ l INTER {x | x >= c:real} <> {}}) =
                               {l | l IN d /\ (\l. l INTER {x | x >= c} <> {}) l}``] THEN
      REWRITE_TAC[SET_RULE ``{x | x IN s /\ P x} SUBSET s``] THEN
      ONCE_REWRITE_TAC [METIS [] ``((f o (\l. l INTER {x | x <= c:real})) x = 0) =
       (\x. ((f:(real -> bool) -> real o (\l. l INTER {x | x <= c})) x = 0)) x``] THEN
      ONCE_REWRITE_TAC [METIS [] ``((f o (\l. l INTER {x | x >= c:real})) x = 0) =
       (\x. ((f:(real -> bool) -> real o (\l. l INTER {x | x >= c})) x = 0)) x``] THEN
      REWRITE_TAC[SET_RULE ``(x IN s /\ ~(x IN {l | l IN s /\ P l}) ==> Q x) <=>
                             (x IN s ==> ~P x ==> Q x)``] THEN
      SIMP_TAC std_ss [o_THM] THEN ASM_MESON_TAC[EMPTY_AS_INTERVAL, CONTENT_EMPTY]]);

val lemma2 = prove (
   ``!f:(real->bool)->real B.
      (!a b. (content(interval[a,b]) = &0) ==> (f(interval[a,b]) = &0)) /\
      (!d. d division_of interval[a,b] ==> sum d f <= B)
      ==> !d1 d2. d1 division_of (interval[a,b] INTER {x | x <= c}) /\
                  d2 division_of (interval[a,b] INTER {x | x >= c})
                  ==> sum d1 f + sum d2 f <= B``,
    REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``d1 UNION d2:(real->bool)->bool``) THEN
    KNOW_TAC ``(d1:(real->bool)->bool) UNION d2 division_of interval [(a,b)]`` THENL
    [ (* goal 1 (of 2) *)
      SUBGOAL_THEN
       ``interval[a,b] = (interval[a,b] INTER {x:real | x <= c}) UNION
                        (interval[a,b] INTER {x:real | x >= c})``
      SUBST1_TAC THENL
       [MATCH_MP_TAC(SET_RULE
         ``(!x. x IN t \/ x IN u) ==> (s = s INTER t UNION s INTER u)``) THEN
        SIMP_TAC std_ss [GSPECIFICATION] THEN REAL_ARITH_TAC,
        MATCH_MP_TAC DIVISION_DISJOINT_UNION THEN ASM_REWRITE_TAC[] THEN
        REWRITE_TAC[GSYM INTERIOR_INTER] THEN
        MATCH_MP_TAC(SET_RULE
         ``!t. interior s SUBSET interior t /\ (interior t = {})
              ==> (interior s = {})``) THEN
        EXISTS_TAC ``{x:real | x = c}`` THEN CONJ_TAC THENL
         [ALL_TAC, REWRITE_TAC[INTERIOR_STANDARD_HYPERPLANE]] THEN
        MATCH_MP_TAC SUBSET_INTERIOR THEN
        SIMP_TAC std_ss [SUBSET_DEF, IN_INTER, GSPECIFICATION] THEN REAL_ARITH_TAC],
      (* goal 2 (of 2) *)
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
      MATCH_MP_TAC(REAL_ARITH ``(x = y) ==> x <= b ==> y <= b:real``) THEN
      MATCH_MP_TAC SUM_UNION_NONZERO THEN
      REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_FINITE], ALL_TAC]) THEN
      X_GEN_TAC ``k:real->bool`` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
      SUBGOAL_THEN ``?u v:real. k = interval[u,v]``
        (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC)
      THENL [ASM_MESON_TAC[division_of], ALL_TAC] THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC CONTENT_0_SUBSET_GEN THEN
      EXISTS_TAC ``interval[a,b] INTER {x:real | x = c}`` THEN CONJ_TAC THENL
      [ (* goal 2.1 (of 2) *)
        MATCH_MP_TAC SUBSET_TRANS THEN
        EXISTS_TAC ``(interval[a,b] INTER {x:real | x <= c}) INTER
                     (interval[a,b] INTER {x:real | x >= c})`` THEN
        CONJ_TAC THENL
        [ ONCE_REWRITE_TAC[SUBSET_INTER] THEN ASM_MESON_TAC[division_of],
          REWRITE_TAC[SET_RULE
            ``(s INTER t) INTER (s INTER u) = s INTER t INTER u``] THEN
          SIMP_TAC std_ss [SUBSET_DEF, IN_INTER, GSPECIFICATION] THEN
          RW_TAC std_ss [] \\
          REWRITE_TAC [GSYM REAL_LE_ANTISYM] >> fs [real_ge] ],
        (* goal 2.2 (of 2) *)
        SIMP_TAC std_ss [BOUNDED_INTER, BOUNDED_INTERVAL] THEN
        GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV)
         [REAL_ARITH ``(x = y) <=> x <= y /\ x >= y:real``] THEN
        REWRITE_TAC[SET_RULE
         ``{x | x <= c /\ x >= c} = {x | x <= c} INTER {x | x >= c}``] THEN
        ASM_SIMP_TAC std_ss [INTER_ASSOC, INTERVAL_SPLIT] THEN
        SIMP_TAC std_ss [CONTENT_EQ_0, min_def, max_def] THEN KILL_TAC THEN
        rpt COND_CASES_TAC >> fs [REAL_LE_REFL] >> REAL_ASM_ARITH_TAC
   ] ]);

val OPERATIVE_LIFTED_SETVARIATION = store_thm ("OPERATIVE_LIFTED_SETVARIATION",
 ``!f:(real->bool)->real.
        operative(+) f
        ==> operative (lifted(+))
                      (\i. if f has_bounded_setvariation_on i
                           then SOME(set_variation i f) else NONE)``,
  REWRITE_TAC[operative, NEUTRAL_REAL_ADD] THEN REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o GSYM)) THEN
  ASM_SIMP_TAC std_ss [HAS_BOUNDED_SETVARIATION_ON_NULL, BOUNDED_INTERVAL,
   MONOIDAL_REAL_ADD, SET_VARIATION_ON_NULL, NEUTRAL_LIFTED,
   NEUTRAL_REAL_ADD] THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``, ``c:real``] THEN
  ASM_CASES_TAC
   ``(f:(real->bool)->real) has_bounded_setvariation_on interval[a,b]`` THEN
  ASM_REWRITE_TAC[] THENL
   [SUBGOAL_THEN
     ``(f:(real->bool)->real) has_bounded_setvariation_on
       interval[a,b] INTER {x | x <= c} /\
       (f:(real->bool)->real) has_bounded_setvariation_on
       interval[a,b] INTER {x | x >= c}``
    ASSUME_TAC THENL
     [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
       (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_SETVARIATION_ON_SUBSET)) THEN
      REWRITE_TAC[INTER_SUBSET],
      ALL_TAC] THEN
    ASM_REWRITE_TAC[lifted] THEN AP_TERM_TAC THEN
    REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL
     [MATCH_MP_TAC SET_VARIATION_UBOUND_ON_INTERVAL THEN ASM_REWRITE_TAC[] THEN
      REPEAT STRIP_TAC THEN MATCH_MP_TAC
       (SIMP_RULE std_ss [AND_IMP_INTRO, RIGHT_IMP_FORALL_THM] lemma1) THEN
      MAP_EVERY EXISTS_TAC [``a:real``, ``b:real``] THEN
      ASM_SIMP_TAC std_ss [ABS_0] THEN CONJ_TAC THENL
       [REPEAT GEN_TAC THEN
        MATCH_MP_TAC(REAL_ARITH
          ``(x:real = y + z) ==> abs(x) <= abs y + abs z``) THEN
        ASM_SIMP_TAC std_ss [],
        FIRST_X_ASSUM(fn th => MP_TAC th THEN MATCH_MP_TAC MONO_AND) THEN
        ASM_SIMP_TAC std_ss [INTERVAL_SPLIT, SET_VARIATION_WORKS_ON_INTERVAL]],
      ONCE_REWRITE_TAC[REAL_ARITH ``x + y <= z <=> x <= z - y:real``] THEN
      ASM_SIMP_TAC std_ss [INTERVAL_SPLIT] THEN
      MATCH_MP_TAC SET_VARIATION_UBOUND_ON_INTERVAL THEN
      ASM_SIMP_TAC std_ss [GSYM INTERVAL_SPLIT] THEN
      X_GEN_TAC ``d1:(real->bool)->bool`` THEN STRIP_TAC THEN
      ONCE_REWRITE_TAC[REAL_ARITH ``x <= y - z <=> z <= y - x:real``] THEN
      ASM_SIMP_TAC std_ss [INTERVAL_SPLIT] THEN
      MATCH_MP_TAC SET_VARIATION_UBOUND_ON_INTERVAL THEN
      ASM_SIMP_TAC std_ss [GSYM INTERVAL_SPLIT] THEN
      X_GEN_TAC ``d2:(real->bool)->bool`` THEN STRIP_TAC THEN
      REWRITE_TAC[REAL_ARITH ``x <= y - z <=> z + x <= y:real``] THEN
      REPEAT STRIP_TAC THEN MATCH_MP_TAC
       (SIMP_RULE std_ss [AND_IMP_INTRO, RIGHT_IMP_FORALL_THM] lemma2) THEN
      ASM_SIMP_TAC std_ss [ABS_0, SET_VARIATION_WORKS_ON_INTERVAL]],
    REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[lifted]) THEN
    UNDISCH_TAC ``~(f has_bounded_setvariation_on interval [(a,b)])`` THEN
    MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN
    REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_INTERVAL] THEN
    EXISTS_TAC ``set_variation (interval[a,b] INTER {x | x <= c})
                              (f:(real->bool)->real) +
                set_variation (interval[a,b] INTER {x | x >= c}) f`` THEN
    REPEAT STRIP_TAC THEN MATCH_MP_TAC
       (SIMP_RULE std_ss [AND_IMP_INTRO, RIGHT_IMP_FORALL_THM] lemma1) THEN
      MAP_EVERY EXISTS_TAC [``a:real``, ``b:real``] THEN
      ASM_SIMP_TAC std_ss [ABS_0] THEN REPEAT CONJ_TAC THENL
       [REPEAT GEN_TAC THEN
        MATCH_MP_TAC(REAL_ARITH
          ``(x:real = y + z) ==> abs(x) <= abs y + abs z``) THEN
        ASM_SIMP_TAC std_ss [],
        UNDISCH_TAC
         ``(f:(real->bool)->real) has_bounded_setvariation_on
          (interval[a,b] INTER {x | x <= c})`` THEN
        ASM_SIMP_TAC std_ss [INTERVAL_SPLIT, SET_VARIATION_WORKS_ON_INTERVAL],
        UNDISCH_TAC
         ``(f:(real->bool)->real) has_bounded_setvariation_on
          (interval[a,b] INTER {x | x >= c})`` THEN
        ASM_SIMP_TAC std_ss [INTERVAL_SPLIT, SET_VARIATION_WORKS_ON_INTERVAL]]]);

val HAS_BOUNDED_SETVARIATION_ON_DIVISION = store_thm ("HAS_BOUNDED_SETVARIATION_ON_DIVISION",
 ``!f:(real->bool)->real a b d.
        operative (+) f /\ d division_of interval[a,b]
        ==> ((!k. k IN d ==> f has_bounded_setvariation_on k) <=>
             f has_bounded_setvariation_on interval[a,b])``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC OPERATIVE_DIVISION_AND THEN
  ASM_REWRITE_TAC[operative, NEUTRAL_AND] THEN CONJ_TAC THENL
   [RULE_ASSUM_TAC(REWRITE_RULE[operative, NEUTRAL_REAL_ADD]) THEN
    ASM_SIMP_TAC std_ss [HAS_BOUNDED_SETVARIATION_ON_NULL, BOUNDED_INTERVAL],
    FIRST_ASSUM(MP_TAC o MATCH_MP OPERATIVE_LIFTED_SETVARIATION) THEN
    REWRITE_TAC[operative] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN
    POP_ASSUM K_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
    POP_ASSUM (MP_TAC o SPECL [``a:real``,``b:real``,``c:real``]) THEN
    SIMP_TAC std_ss [] THEN
    REPEAT(COND_CASES_TAC THEN
           ASM_SIMP_TAC std_ss [lifted, NOT_NONE_SOME, option_CLAUSES])]);

val lemma0 = prove (
   ``!op x y. ((lifted op (SOME x) y = SOME z) <=> ?w. (y = SOME w) /\ (op x w = z))``,
    GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC [METIS []
     ``((lifted op (SOME x) y = SOME z) <=> ?w. (y = SOME w) /\ (op x w = z)) =
  (\y. (lifted op (SOME x) y = SOME z) <=> ?w. (y = SOME w) /\ (op x w = z)) y``] THEN
    MATCH_MP_TAC option_induction THEN
    SIMP_TAC std_ss [lifted, NOT_NONE_SOME, SOME_11] THEN
    MESON_TAC[]);

val lemma = prove (
   ``!P op f s z.
          monoidal op /\ FINITE s /\
          (iterate(lifted op) s (\i. if P i then SOME(f i) else NONE) = SOME z)
          ==> (iterate op s f = z)``,
    SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
    REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
    ONCE_REWRITE_TAC [METIS []
     ``!s. (!z. (iterate (lifted op) s (\i. if P i then SOME (f i) else NONE) =
     SOME z) ==> (iterate op s f = z)) =
       (\s. !z. (iterate (lifted op) s (\i. if P i then SOME (f i) else NONE) =
     SOME z) ==> (iterate op s f = z)) s``] THEN
    MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
    ASM_SIMP_TAC std_ss [ITERATE_CLAUSES, MONOIDAL_LIFTED, NEUTRAL_LIFTED] THEN
    SIMP_TAC std_ss [SOME_11] THEN REPEAT GEN_TAC THEN
    STRIP_TAC THEN GEN_TAC THEN COND_CASES_TAC THEN
    SIMP_TAC std_ss [lifted, NOT_NONE_SOME] THEN ASM_MESON_TAC[lemma0]);

val SET_VARIATION_ON_DIVISION = store_thm ("SET_VARIATION_ON_DIVISION",
 ``!f:(real->bool)->real a b d.
        operative (+) f /\ d division_of interval[a,b] /\
        f has_bounded_setvariation_on interval[a,b]
        ==> (sum d (\k. set_variation k f) = set_variation (interval[a,b]) f)``,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP OPERATIVE_LIFTED_SETVARIATION) THEN
  DISCH_THEN(MP_TAC o SPECL[``d:(real->bool)->bool``, ``a:real``, ``b:real``] o
    MATCH_MP (REWRITE_RULE [TAUT `a /\ b /\ c ==> d <=> b ==> a /\ c ==> d`]
        OPERATIVE_DIVISION)) THEN
  ASM_SIMP_TAC std_ss [MONOIDAL_LIFTED, MONOIDAL_REAL_ADD] THEN
  MP_TAC(ISPECL
   [``\k. (f:(real->bool)->real) has_bounded_setvariation_on k``,
    ``(+):real->real->real``,
    ``\k. set_variation k (f:(real->bool)->real)``,
    ``d:(real->bool)->bool``,
    ``set_variation (interval[a,b]) (f:(real->bool)->real)``]
   lemma) THEN
  FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
  ASM_SIMP_TAC std_ss [sum_def, MONOIDAL_REAL_ADD]);

val SET_VARIATION_MONOTONE = store_thm ("SET_VARIATION_MONOTONE",
 ``!f:(real->bool)->real s t.
        f has_bounded_setvariation_on s /\ t SUBSET s
        ==> set_variation t f <= set_variation s f``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[set_variation] THEN
  MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN REPEAT CONJ_TAC THENL
   [SIMP_TAC std_ss [GSYM MEMBER_NOT_EMPTY, GSPECIFICATION] THEN
    MAP_EVERY EXISTS_TAC [``{}:(real->bool)->bool``] THEN
    REWRITE_TAC[SUM_CLAUSES] THEN EXISTS_TAC ``{}:real->bool`` THEN
    REWRITE_TAC[EMPTY_SUBSET, DIVISION_OF_TRIVIAL],
    ONCE_REWRITE_TAC [METIS []
     ``{sum d (\k. abs (f k)) | ?t. d division_of t /\ t SUBSET s} =
  {(\d. sum d (\k. abs (f k))) d | (\d. ?t. d division_of t /\ t SUBSET s) d}``] THEN
    MATCH_MP_TAC(SET_RULE
     ``(!d. P d ==> Q d) ==> {f d | P d} SUBSET {f d | Q d}``) THEN
    ASM_MESON_TAC[SUBSET_TRANS],
    SIMP_TAC std_ss [FORALL_IN_GSPEC, LEFT_IMP_EXISTS_THM] THEN
    ASM_REWRITE_TAC[GSYM has_bounded_setvariation_on]]);

val HAS_BOUNDED_SETVARIATION_REFLECT2_EQ_AND_SET_VARIATION_REFLECT2 = store_thm ("HAS_BOUNDED_SETVARIATION_REFLECT2_EQ_AND_SET_VARIATION_REFLECT2",
 ``(!f:(real->bool)->real s.
        (\k. f(IMAGE (\x. -x) k)) has_bounded_setvariation_on (IMAGE (\x. -x) s) <=>
        f has_bounded_setvariation_on s) /\
   (!f:(real->bool)->real s.
        set_variation (IMAGE (\x. -x) s) (\k. f(IMAGE (\x. -x) k)) =
        set_variation s f)``,
  ONCE_REWRITE_TAC [METIS [] ``(IMAGE (\x. -x) s) = (\s. (IMAGE (\x. -x) s)) s:real->bool``] THEN
  ONCE_REWRITE_TAC [METIS [] ``(\k. f ((\s. IMAGE (\x. -x) s) k)) =
                          (\f. (\k. f ((\s. IMAGE (\x. -x) s) k))) f:(real->bool)->real``] THEN
  MATCH_MP_TAC SETVARIATION_EQUAL_LEMMA THEN
  EXISTS_TAC ``IMAGE ((\x. -x):real->real)`` THEN
  SIMP_TAC std_ss [IMAGE_SUBSET, GSYM IMAGE_COMPOSE, o_DEF] THEN
  SIMP_TAC std_ss [REAL_NEG_NEG, IMAGE_ID, REFLECT_INTERVAL] THEN
  SIMP_TAC std_ss [ETA_AX, DIVISION_OF_REFLECT] THEN
  SIMP_TAC std_ss [EQ_INTERVAL, TAUT `~q /\ (p /\ q \/ r) <=> ~q /\ r`] THEN
  REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ q /\ p`] THEN
  SIMP_TAC std_ss [UNWIND_THM1, GSYM MONO_NOT_EQ] THEN
  SIMP_TAC std_ss [GSYM INTERVAL_EQ_EMPTY, REAL_LT_NEG] THEN
  METIS_TAC [ETA_AX, DIVISION_OF_REFLECT]);

val HAS_BOUNDED_SETVARIATION_REFLECT2_EQ = store_thm ("HAS_BOUNDED_SETVARIATION_REFLECT2_EQ",
  ``(!f:(real->bool)->real s.
        (\k. f(IMAGE (\x. -x) k)) has_bounded_setvariation_on (IMAGE (\x. -x) s) <=>
        f has_bounded_setvariation_on s)``,
  REWRITE_TAC [HAS_BOUNDED_SETVARIATION_REFLECT2_EQ_AND_SET_VARIATION_REFLECT2]);

val SET_VARIATION_REFLECT2 = store_thm ("SET_VARIATION_REFLECT2",
  ``(!f:(real->bool)->real s.
        set_variation (IMAGE (\x. -x) s) (\k. f(IMAGE (\x. -x) k)) =
        set_variation s f)``,
  REWRITE_TAC [HAS_BOUNDED_SETVARIATION_REFLECT2_EQ_AND_SET_VARIATION_REFLECT2]);

val HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ_AND_SET_VARIATION_TRANSLATION2 = store_thm ("HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ_AND_SET_VARIATION_TRANSLATION2",
 ``(!a f:(real->bool)->real s.
          (\k. f(IMAGE (\x. a + x) k))
          has_bounded_setvariation_on (IMAGE (\x. -a + x) s) <=>
          f has_bounded_setvariation_on s) /\
   (!a f:(real->bool)->real s.
          set_variation (IMAGE (\x. -a + x) s) (\k. f(IMAGE (\x. a + x) k)) =
          set_variation s f)``,
  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN X_GEN_TAC ``a:real`` THEN
  SIMP_TAC std_ss [FORALL_AND_THM] THEN
  ONCE_REWRITE_TAC [METIS [] ``(IMAGE (\x. -a + x) s) =
                          (\s. (IMAGE (\x. -a + x) s)) s:real->bool``] THEN
  ONCE_REWRITE_TAC [METIS [] ``(\k. f (IMAGE (\x. a + x) k)) =
                         (\f. ((\k. f (IMAGE (\x. a + x) k)))) (f:(real->bool)->real)``] THEN
  MATCH_MP_TAC SETVARIATION_EQUAL_LEMMA THEN
  EXISTS_TAC ``\s. IMAGE (\x:real. a + x) s`` THEN
  SIMP_TAC std_ss [IMAGE_SUBSET, GSYM IMAGE_COMPOSE, o_DEF] THEN
  REWRITE_TAC[REAL_ARITH ``a + -a + x:real = x``, IMAGE_ID,
              REAL_ARITH ``-a + a + x:real = x``] THEN
  SIMP_TAC std_ss [GSYM INTERVAL_TRANSLATION] THEN
  SIMP_TAC std_ss [EQ_INTERVAL, TAUT `~q /\ (p /\ q \/ r) <=> ~q /\ r`] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ q /\ p`] THEN
  SIMP_TAC std_ss [UNWIND_THM1, GSYM MONO_NOT_EQ] THEN
  REWRITE_TAC[GSYM INTERVAL_EQ_EMPTY, REAL_LT_LADD] THEN
  REPEAT STRIP_TAC THEN
  SIMP_TAC std_ss [REAL_ARITH ``a + (-a + x) = x:real``, IMAGE_ID] THEN
  SIMP_TAC std_ss [REAL_ARITH ``-a + (a + x) = x:real``, IMAGE_ID] THEN
  (GEN_REWR_TAC (LAND_CONV o LAND_CONV) [ETA_AX] THEN
   ASM_SIMP_TAC std_ss [DIVISION_OF_TRANSLATION]));

val HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ = store_thm ("HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ",
 ``(!a f:(real->bool)->real s.
          (\k. f(IMAGE (\x. a + x) k))
          has_bounded_setvariation_on (IMAGE (\x. -a + x) s) <=>
          f has_bounded_setvariation_on s)``,
  REWRITE_TAC [HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ_AND_SET_VARIATION_TRANSLATION2]);

val SET_VARIATION_TRANSLATION2 = store_thm ("SET_VARIATION_TRANSLATION2",
 ``(!a f:(real->bool)->real s.
          set_variation (IMAGE (\x. -a + x) s) (\k. f(IMAGE (\x. a + x) k)) =
          set_variation s f)``,
  REWRITE_TAC [HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ_AND_SET_VARIATION_TRANSLATION2]);

val HAS_BOUNDED_SETVARIATION_TRANSLATION = store_thm ("HAS_BOUNDED_SETVARIATION_TRANSLATION",
 ``!f:(real->bool)->real s a.
        f has_bounded_setvariation_on s
        ==> (\k. f(IMAGE (\x. a + x) k))
            has_bounded_setvariation_on (IMAGE (\x. -a + x) s)``,
  SIMP_TAC real_ss [HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ]);

(* ------------------------------------------------------------------------- *)
(* Absolute integrability (this is the same as Lebesgue integrability).      *)
(* ------------------------------------------------------------------------- *)

val _ = set_fixity "absolutely_integrable_on" (Infix(NONASSOC, 450));

val absolutely_integrable_on = new_definition ("absolutely_integrable_on",
 ``f absolutely_integrable_on s <=>
        f integrable_on s /\ (\x. abs(f x)) integrable_on s``);

val ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE = store_thm ("ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE",
 ``!f s. f absolutely_integrable_on s ==> f integrable_on s``,
  SIMP_TAC std_ss [absolutely_integrable_on]);

val ABSOLUTELY_INTEGRABLE_IMP_ABS_INTEGRABLE = store_thm ("ABSOLUTELY_INTEGRABLE_IMP_ABS_INTEGRABLE",
 ``!f:real->real s.
     f absolutely_integrable_on s ==> (\x. abs (f x)) integrable_on s``,
  REWRITE_TAC[absolutely_integrable_on] THEN MESON_TAC[]);

val ABSOLUTELY_INTEGRABLE_LE = store_thm ("ABSOLUTELY_INTEGRABLE_LE",
 ``!f:real->real s.
        f absolutely_integrable_on s
        ==> abs(integral s f) <= (integral s (\x. abs(f x)))``,
  REWRITE_TAC[absolutely_integrable_on] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_ABS_BOUND_INTEGRAL THEN
  ASM_SIMP_TAC std_ss [REAL_LE_REFL]);

val ABSOLUTELY_INTEGRABLE_ON_NULL = store_thm ("ABSOLUTELY_INTEGRABLE_ON_NULL",
 ``!f a b. (content(interval[a,b]) = &0)
           ==> f absolutely_integrable_on interval[a,b]``,
  SIMP_TAC std_ss [absolutely_integrable_on, INTEGRABLE_ON_NULL]);

val ABSOLUTELY_INTEGRABLE_0 = store_thm ("ABSOLUTELY_INTEGRABLE_0",
 ``!s. (\x. 0) absolutely_integrable_on s``,
  REWRITE_TAC[absolutely_integrable_on, ABS_0, INTEGRABLE_0]);

val ABSOLUTELY_INTEGRABLE_CMUL = store_thm ("ABSOLUTELY_INTEGRABLE_CMUL",
 ``!f s c. f absolutely_integrable_on s
           ==> (\x. c * f(x)) absolutely_integrable_on s``,
  SIMP_TAC std_ss [absolutely_integrable_on, INTEGRABLE_CMUL, ABS_MUL]);

val ABSOLUTELY_INTEGRABLE_NEG = store_thm ("ABSOLUTELY_INTEGRABLE_NEG",
 ``!f s. f absolutely_integrable_on s
         ==> (\x. -f(x)) absolutely_integrable_on s``,
  SIMP_TAC std_ss [absolutely_integrable_on, INTEGRABLE_NEG, ABS_NEG]);

val ABSOLUTELY_INTEGRABLE_ABS = store_thm ("ABSOLUTELY_INTEGRABLE_ABS",
 ``!f s. f absolutely_integrable_on s
         ==> (\x. abs(f x)) absolutely_integrable_on s``,
  SIMP_TAC std_ss [absolutely_integrable_on, ABS_ABS]);

val ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL = store_thm ("ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL",
 ``!f:real->real s a b.
        f absolutely_integrable_on s /\ interval[a,b] SUBSET s
        ==> f absolutely_integrable_on interval[a,b]``,
  REWRITE_TAC[absolutely_integrable_on] THEN
  MESON_TAC[INTEGRABLE_ON_SUBINTERVAL]);

val ABSOLUTELY_INTEGRABLE_SPIKE = store_thm ("ABSOLUTELY_INTEGRABLE_SPIKE",
 ``!f:real->real g s t.
        negligible s /\ (!x. x IN t DIFF s ==> (g x = f x))
        ==> f absolutely_integrable_on t ==> g absolutely_integrable_on t``,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  REWRITE_TAC[absolutely_integrable_on] THEN MATCH_MP_TAC MONO_AND THEN
  CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_SPIKE THEN
  EXISTS_TAC ``s:real->bool`` THEN ASM_SIMP_TAC std_ss []);

val ABSOLUTELY_INTEGRABLE_RESTRICT_INTER = store_thm ("ABSOLUTELY_INTEGRABLE_RESTRICT_INTER",
 ``!f:real->real s t.
        (\x. if x IN s then f x else 0) absolutely_integrable_on t <=>
        f absolutely_integrable_on (s INTER t)``,
  SIMP_TAC std_ss [absolutely_integrable_on, GSYM INTEGRABLE_RESTRICT_INTER] THEN
  SIMP_TAC std_ss [COND_RAND, ABS_0]);

val ABSOLUTELY_INTEGRABLE_EQ = store_thm ("ABSOLUTELY_INTEGRABLE_EQ",
 ``!f:real->real g s.
        (!x. x IN s ==> (f x = g x)) /\ f absolutely_integrable_on s
        ==> g absolutely_integrable_on s``,
  REWRITE_TAC[absolutely_integrable_on] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC INTEGRABLE_EQ THENL
   [EXISTS_TAC ``f:real->real``,
    EXISTS_TAC ``\x. abs((f:real->real) x)``] THEN
  ASM_SIMP_TAC std_ss []);

val ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION = store_thm ("ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION",
 ``!f:real->real s.
        f absolutely_integrable_on s
        ==> (\k. integral k f) has_bounded_setvariation_on s``,
  REWRITE_TAC[has_bounded_setvariation_on] THEN REPEAT STRIP_TAC THEN
  EXISTS_TAC
   ``integral (s:real->bool) (\x. abs(f x:real))`` THEN
  X_GEN_TAC ``d:(real->bool)->bool`` THEN
  X_GEN_TAC ``t:real->bool`` THEN STRIP_TAC THEN
  SUBGOAL_THEN ``(BIGUNION d:real->bool) SUBSET s`` ASSUME_TAC THENL
   [METIS_TAC[SUBSET_TRANS, division_of], ALL_TAC] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC
   ``integral (BIGUNION d) (\x. abs((f:real->real) x))`` THEN
  CONJ_TAC THENL
   [ALL_TAC,
    MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN
    ASM_SIMP_TAC real_ss [ABS_POS] THEN CONJ_TAC THENL
     [MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN
      EXISTS_TAC ``s:real->bool`` THEN
      EXISTS_TAC ``d:(real->bool)->bool`` THEN CONJ_TAC THENL
       [ASM_MESON_TAC[DIVISION_OF_SUBSET, division_of], ALL_TAC] THEN
      ASM_SIMP_TAC std_ss [],
      ALL_TAC] THEN
    MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
    MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ABS THEN ASM_REWRITE_TAC[]] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC
   ``sum d (\i. integral i (\x:real. abs(f x:real)))`` THEN
  CONJ_TAC THENL
   [FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
    ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC SUM_LE THEN
    ASM_REWRITE_TAC[o_THM] THEN
    FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
    MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN DISCH_TAC THEN
    MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_LE THEN
    MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN
    EXISTS_TAC ``s:real->bool`` THEN METIS_TAC[division_of, SUBSET_TRANS],
    MATCH_MP_TAC REAL_EQ_IMP_LE THEN
    CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMBINE_DIVISION_TOPDOWN THEN
    CONJ_TAC THENL [ALL_TAC, ASM_MESON_TAC[DIVISION_OF_UNION_SELF]] THEN
    MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN
    MAP_EVERY EXISTS_TAC [``s:real->bool``, ``d:(real->bool)->bool``] THEN
    CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_UNION_SELF], ALL_TAC] THEN
    ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
    MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ABS THEN ASM_SIMP_TAC real_ss []]);

val lemma = prove (
 ``!f:'a->real g s e.
        sum s (\x. abs(f x - g x)) < e
        ==> FINITE s
            ==> abs(sum s (\x. abs(f x)) - sum s (\x. abs(g x))) < e``,
  REPEAT GEN_TAC THEN SIMP_TAC std_ss [GSYM SUM_SUB] THEN
  DISCH_THEN(fn th => DISCH_TAC THEN MP_TAC th) THEN
  MATCH_MP_TAC(REAL_ARITH ``x <= y ==> y < e ==> x < e:real``) THEN
  W(MP_TAC o PART_MATCH (lhand o rand) SUM_ABS o lhand o snd) THEN
  ASM_SIMP_TAC std_ss [] THEN
  MATCH_MP_TAC(REAL_ARITH ``y <= z ==> x <= y ==> x <= z:real``) THEN
  MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC std_ss [] THEN
  REPEAT STRIP_TAC THEN REAL_ARITH_TAC);

Theorem BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE_INTERVAL :
    !f:real->real a b.
        f integrable_on interval[a,b] /\
        (\k. integral k f) has_bounded_setvariation_on interval[a,b]
        ==> f absolutely_integrable_on interval[a,b]
Proof
  REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_INTERVAL] THEN
  REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[absolutely_integrable_on] THEN
  MP_TAC(ISPEC ``IMAGE (\d. sum d (\k. abs(integral k (f:real->real))))
                      {d | d division_of interval[a,b] }``
         SUP) THEN
  SIMP_TAC std_ss [FORALL_IN_IMAGE, IMAGE_EQ_EMPTY] THEN
  SIMP_TAC std_ss [GSYM MEMBER_NOT_EMPTY, GSPECIFICATION] THEN
  ABBREV_TAC
   ``i = sup (IMAGE (\d. sum d (\k. abs(integral k (f:real->real))))
                      {d | d division_of interval[a,b] })`` THEN
  KNOW_TAC ``(?(x :(real -> bool) -> bool).
    x division_of interval [((a :real),(b :real))]) /\
 (?(b' :real). !(d :(real -> bool) -> bool).
      d division_of interval [(a,b)] ==>
      sum d (\(k :real -> bool). abs (integral k (f :real -> real))) <=
      b')`` THENL
   [REWRITE_TAC[ELEMENTARY_INTERVAL] THEN ASM_MESON_TAC[],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  STRIP_TAC THEN REWRITE_TAC[integrable_on] THEN EXISTS_TAC ``i:real`` THEN
  REWRITE_TAC[has_integral] THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``i - e / &2:real``) THEN
  ASM_SIMP_TAC std_ss [REAL_ARITH
   ``&0 < e / &2 ==> ~(i <= i - e / &2:real)``, REAL_HALF] THEN
  SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP, REAL_NOT_LE, LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC ``d:(real->bool)->bool`` THEN STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
  SUBGOAL_THEN
   ``!x. ?e. &0 < e /\
            !i. i IN d /\ ~(x IN i) ==> (ball(x:real,e) INTER i = {})``
  MP_TAC THENL
   [X_GEN_TAC ``x:real`` THEN MP_TAC(ISPECL
     [``BIGUNION {i:real->bool | i IN d /\ ~(x IN i)}``, ``x:real``]
     SEPARATE_POINT_CLOSED) THEN
    KNOW_TAC ``(closed
    (BIGUNION
       {i | i IN (d :(real -> bool) -> bool) /\ (x :real) NOTIN i}) :
    bool) /\ x NOTIN BIGUNION {i | i IN d /\ x NOTIN i}`` THENL
     [CONJ_TAC THENL [ALL_TAC, SET_TAC[]] THEN
      MATCH_MP_TAC CLOSED_BIGUNION THEN
      ASM_SIMP_TAC std_ss [FINITE_RESTRICT, GSPECIFICATION, IMP_CONJ] THEN
      FIRST_ASSUM(fn t => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION t]) THEN
      REWRITE_TAC[CLOSED_INTERVAL],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    DISCH_THEN (X_CHOOSE_TAC ``k:real``) THEN EXISTS_TAC ``k:real`` THEN
    POP_ASSUM MP_TAC THEN
    SIMP_TAC std_ss [FORALL_IN_BIGUNION, EXTENSION, IN_INTER, NOT_IN_EMPTY, IN_BALL] THEN
    SIMP_TAC std_ss [GSPECIFICATION, DE_MORGAN_THM, REAL_NOT_LT] THEN MESON_TAC[],
    ALL_TAC] THEN
  SIMP_TAC std_ss [SKOLEM_THM, LEFT_IMP_EXISTS_THM, FORALL_AND_THM] THEN
  X_GEN_TAC ``k:real->real`` THEN STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o SPEC ``e / &2:real`` o MATCH_MP HENSTOCK_LEMMA) THEN
  ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN ``g:real->real->bool`` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC ``\x:real. g(x) INTER ball(x,k x)`` THEN CONJ_TAC THENL
   [ONCE_REWRITE_TAC [METIS [] ``(\x. g x INTER ball (x,k x)) =
                                 (\x. g x INTER (\x. ball (x,k x)) x)``] THEN
    MATCH_MP_TAC GAUGE_INTER THEN ASM_REWRITE_TAC[] THEN
    ASM_SIMP_TAC std_ss [gauge_def, CENTRE_IN_BALL, OPEN_BALL],
    ALL_TAC] THEN
  ONCE_REWRITE_TAC [METIS [] ``(\x. g x INTER ball (x,k x)) =
                               (\x. g x INTER (\x. ball (x,k x)) x)``] THEN
  REWRITE_TAC[FINE_INTER] THEN X_GEN_TAC ``p:(real#(real->bool))->bool`` THEN
  STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
  ABBREV_TAC
   ``p' = {(x:real,k:real->bool) |
                ?i l. x IN i /\ i IN d /\ (x,l) IN p /\ (k = i INTER l)}`` THEN
  SUBGOAL_THEN ``g FINE (p':(real#(real->bool))->bool)`` ASSUME_TAC THENL
   [EXPAND_TAC "p'" THEN
    MP_TAC(ASSUME ``g FINE (p:(real#(real->bool))->bool)``) THEN
    SIMP_TAC std_ss [FINE, IN_ELIM_PAIR_THM] THEN
    MESON_TAC[SET_RULE ``k SUBSET l ==> (i INTER k) SUBSET l``],
    ALL_TAC] THEN
  SUBGOAL_THEN ``p' tagged_division_of interval[a:real,b]`` ASSUME_TAC THENL
  [ (* goal 1 (of 2) *)
    REWRITE_TAC[TAGGED_DIVISION_OF] THEN EXPAND_TAC "p'" THEN
    SIMP_TAC std_ss [IN_ELIM_PAIR_THM] THEN
    UNDISCH_TAC ``p tagged_division_of interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o REWRITE_RULE [TAGGED_DIVISION_OF]) THEN
    MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
     [DISCH_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN
      EXISTS_TAC
       ``IMAGE (\(k,(x,l)). x,k INTER l)
              {k,xl | k IN (d:(real->bool)->bool) /\
                      xl IN (p:(real#(real->bool))->bool)}`` THEN
      ASM_SIMP_TAC std_ss [IMAGE_FINITE, FINITE_PRODUCT] THEN
      EXPAND_TAC "p'" THEN SIMP_TAC std_ss [SUBSET_DEF, FORALL_PROD] THEN
      SIMP_TAC std_ss [IN_ELIM_PAIR_THM, IN_IMAGE, EXISTS_PROD, PAIR_EQ] THEN
      MESON_TAC[],
      ALL_TAC] THEN
    MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
     [DISCH_TAC THEN MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN
      SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
      MAP_EVERY X_GEN_TAC [``i:real->bool``, ``l:real->bool``] THEN
      STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN
      ASM_SIMP_TAC std_ss [IN_INTER] THEN CONJ_TAC THENL
       [MATCH_MP_TAC(SET_RULE ``l SUBSET s ==> (k INTER l) SUBSET s``) THEN
        ASM_MESON_TAC[],
        ALL_TAC] THEN
      FIRST_X_ASSUM(MP_TAC o SPECL [``x:real``, ``l:real->bool``]) THEN
      ASM_SIMP_TAC std_ss [] THEN STRIP_TAC THEN ASM_SIMP_TAC std_ss [] THEN
      UNDISCH_TAC ``d division_of interval [(a,b)]`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
      DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
      DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC o SPEC ``i:real->bool``) ASSUME_TAC) THEN
      ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
      ASM_REWRITE_TAC[INTER_INTERVAL] THEN MESON_TAC[],
      ALL_TAC] THEN
    MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
     [DISCH_TAC THEN MAP_EVERY X_GEN_TAC
       [``x1:real``, ``k1:real->bool``, ``x2:real``, ``k2:real->bool``] THEN
      DISCH_THEN(CONJUNCTS_THEN2
       (X_CHOOSE_THEN ``i1:real->bool`` (X_CHOOSE_THEN ``l1:real->bool``
          STRIP_ASSUME_TAC)) MP_TAC) THEN
      ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
      DISCH_THEN(CONJUNCTS_THEN2
       (X_CHOOSE_THEN ``i2:real->bool`` (X_CHOOSE_THEN ``l2:real->bool``
          STRIP_ASSUME_TAC)) ASSUME_TAC) THEN
      ASM_REWRITE_TAC [] THEN
      RULE_ASSUM_TAC (REWRITE_RULE [GSYM DE_MORGAN_THM, GSYM PAIR_EQ]) THEN
      MATCH_MP_TAC(SET_RULE
       ``((interior(i1) INTER interior(i2) = {}) \/
         (interior(l1) INTER interior(l2) = {})) /\
        interior(i1 INTER l1) SUBSET interior(i1) /\
        interior(i2 INTER l2) SUBSET interior(i2) /\
        interior(i1 INTER l1) SUBSET interior(l1) /\
        interior(i2 INTER l2) SUBSET interior(l2)
        ==> (interior(i1 INTER l1) INTER interior(i2 INTER l2) = {})``) THEN
      SIMP_TAC std_ss [SUBSET_INTERIOR, INTER_SUBSET] THEN
      FIRST_X_ASSUM(MP_TAC o SPECL
       [``x1:real``, ``l1:real->bool``, ``x2:real``, ``l2:real->bool``]) THEN
      ASM_SIMP_TAC std_ss [] THEN
      UNDISCH_TAC ``d division_of interval [(a,b)]`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
      DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
      DISCH_THEN(MP_TAC o SPECL [``i1:real->bool``, ``i2:real->bool``]) THEN
      ASM_REWRITE_TAC[] THEN
      UNDISCH_TAC ``((x1 :real),(i1 :real -> bool) INTER (l1 :real -> bool)) <>
       ((x2 :real),(k2 :real -> bool))`` THEN
      ASM_REWRITE_TAC[PAIR_EQ] THEN MESON_TAC[],
      ALL_TAC] THEN
    DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
     [SIMP_TAC std_ss [BIGUNION_SUBSET, GSPECIFICATION] THEN
      REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC(SET_RULE ``i SUBSET s ==> (i INTER k) SUBSET s``) THEN
      ASM_MESON_TAC[division_of],
      ALL_TAC] THEN
    REWRITE_TAC[SUBSET_DEF] THEN X_GEN_TAC ``y:real`` THEN DISCH_TAC THEN
    SIMP_TAC std_ss [IN_BIGUNION, GSPECIFICATION] THEN
    SIMP_TAC std_ss [GSYM LEFT_EXISTS_AND_THM, GSYM CONJ_ASSOC] THEN
    KNOW_TAC ``?(l :real -> bool) (x :real) (i :real -> bool) (s :real -> bool).
      (s = i INTER l) /\ x IN i /\  i IN (d :(real -> bool) -> bool) /\
      (x,l) IN (p :real # (real -> bool) -> bool) /\ (y :real) IN (i INTER l)`` THENL
    [ALL_TAC, METIS_TAC []] THEN
    SIMP_TAC std_ss [IN_INTER, UNWIND_THM2] THEN
    UNDISCH_TAC ``BIGUNION {k | ?x. (x:real,k) IN p} = interval [(a,b)]`` THEN
    DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [EXTENSION]) THEN
    DISCH_THEN(MP_TAC o SPEC ``y:real``) THEN ASM_REWRITE_TAC[] THEN
    SIMP_TAC std_ss [IN_BIGUNION, GSPECIFICATION, GSYM RIGHT_EXISTS_AND_THM] THEN
    DISCH_THEN (X_CHOOSE_THEN ``l:real->bool`` (X_CHOOSE_TAC ``x:real``)) THEN
    EXISTS_TAC ``l:real->bool`` THEN EXISTS_TAC ``x:real`` THEN POP_ASSUM MP_TAC THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    UNDISCH_TAC ``d division_of interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
    DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC ``y:real``) THEN
    ASM_REWRITE_TAC[IN_BIGUNION] THEN
    DISCH_THEN (X_CHOOSE_TAC ``k:real->bool``) THEN EXISTS_TAC ``k:real->bool`` THEN
    POP_ASSUM MP_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [``x:real``, ``k:real->bool``]) THEN
    GEN_REWR_TAC LAND_CONV [MONO_NOT_EQ] THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
    EXISTS_TAC ``y:real`` THEN ASM_SIMP_TAC std_ss [INTER_DEF, GSPECIFICATION] THEN
    UNDISCH_TAC ``(\x:real. ball (x,k x)) FINE p`` THEN
    REWRITE_TAC[FINE, SUBSET_DEF] THEN ASM_MESON_TAC[],
    ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``p':(real#(real->bool))->bool``) THEN
  ASM_REWRITE_TAC[] THEN
  KNOW_TAC ``p' tagged_partial_division_of interval [(a,b)]`` THENL
  [ASM_MESON_TAC[tagged_division_of],
   DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
  SIMP_TAC std_ss [LAMBDA_PAIR] THEN
  ONCE_REWRITE_TAC [METIS []
   ``(\p. abs (content (SND p) * f (FST p) - integral (SND p) f)) =
     (\p. abs ((\p. content (SND p) * f (FST p)) p - (\p. integral (SND p) f) p))``] THEN
  DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN
  ASM_SIMP_TAC std_ss [o_DEF, SUM_SUB] THEN
  SIMP_TAC std_ss [LAMBDA_PROD, ABS_MUL] THEN
  GEN_REWR_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_HALF] THEN
  MATCH_MP_TAC(REAL_ARITH
    ``!sni. i - e / &2 < sni /\
           sni' <= i /\ sni <= sni' /\ (sf' = sf)
              ==> abs(sf' - sni') < e / &2
                  ==> abs(sf - i) < e / 2 + e / 2:real``) THEN
  EXISTS_TAC ``sum d (\k. abs (integral k (f:real->real)))`` THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
   [MP_TAC(ISPECL [``\k. abs(integral k (f:real->real))``,
                   ``p':(real#(real->bool))->bool``,
                   ``interval[a:real,b]``] SUM_OVER_TAGGED_DIVISION_LEMMA) THEN
    ASM_SIMP_TAC std_ss [INTEGRAL_NULL, ABS_0] THEN DISCH_THEN SUBST1_TAC THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIVISION_OF_TAGGED_DIVISION],
    ALL_TAC] THEN
  SUBGOAL_THEN
   ``p' = {x:real,(i INTER l:real->bool) |
            (x,l) IN p /\ i IN d /\ ~(i INTER l = {})}``
  (ASSUME_TAC) THENL
  [ EXPAND_TAC "p'" THEN GEN_REWR_TAC I [EXTENSION] THEN
    SIMP_TAC std_ss [FORALL_PROD, IN_ELIM_PAIR_THM] THEN
    SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN
    MAP_EVERY X_GEN_TAC [``x:real``, ``k':real->bool``] THEN
    SIMP_TAC std_ss [PAIR_EQ, GSYM CONJ_ASSOC] THEN
    AP_TERM_TAC THEN GEN_REWR_TAC I [FUN_EQ_THM] THEN
    X_GEN_TAC ``i':real->bool`` THEN SIMP_TAC std_ss [] THEN
    GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV)
     [TAUT `A /\ B /\ C /\ D <=> B /\ C /\ D /\ A`] THEN
    AP_TERM_TAC THEN GEN_REWR_TAC I [FUN_EQ_THM] THEN
    X_GEN_TAC ``l:real->bool`` THEN SIMP_TAC std_ss [] THEN
    ASM_CASES_TAC ``k':real->bool = i' INTER l`` THEN ASM_SIMP_TAC real_ss [] THEN
    ASM_SIMP_TAC std_ss [IN_INTER, GSYM MEMBER_NOT_EMPTY] THEN
    EQ_TAC THENL [METIS_TAC[TAGGED_DIVISION_OF], ALL_TAC] THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    DISCH_THEN(X_CHOOSE_THEN ``y:real`` STRIP_ASSUME_TAC) THEN
    ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [``x:real``, ``i':real->bool``]) THEN
    GEN_REWR_TAC LAND_CONV [MONO_NOT_EQ] THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
    EXISTS_TAC ``y:real`` THEN ASM_SIMP_TAC std_ss [INTER_DEF, GSPECIFICATION] THEN
    UNDISCH_TAC ``(\x:real. ball (x,k x)) FINE p`` THEN
    REWRITE_TAC[FINE, SUBSET_DEF] THEN ASM_MESON_TAC[],
    ALL_TAC] THEN
  CONJ_TAC THENL
   [MP_TAC(ISPECL
     [``\y. abs(integral y (f:real->real))``,
      ``p':(real#(real->bool))->bool``,
      ``interval[a:real,b]``]
     SUM_OVER_TAGGED_DIVISION_LEMMA) THEN
    ASM_SIMP_TAC std_ss [INTEGRAL_NULL, ABS_0] THEN DISCH_THEN SUBST1_TAC THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC ``sum {i INTER l | i IN d /\
                 (l IN IMAGE SND (p:(real#(real->bool))->bool))}
                    (\k. abs(integral k (f:real->real)))`` THEN
    CONJ_TAC THENL
     [ALL_TAC,
      MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_SUPERSET THEN
      CONJ_TAC THENL
       [SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_IMAGE] THEN
        SIMP_TAC std_ss [FORALL_PROD] THEN
        SIMP_TAC std_ss [GSPECIFICATION, IN_IMAGE, PAIR_EQ, EXISTS_PROD] THEN
        MESON_TAC[],
        ALL_TAC] THEN
      SIMP_TAC std_ss [GSPECIFICATION, GSYM LEFT_EXISTS_AND_THM, LEFT_IMP_EXISTS_THM,
        EXISTS_PROD] THEN MAP_EVERY X_GEN_TAC [``i:real->bool``, ``l:real->bool``] THEN
      SIMP_TAC std_ss [IN_IMAGE, EXISTS_PROD, UNWIND_THM1] THEN
      DISCH_THEN(CONJUNCTS_THEN2
       (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC ``x:real``)) MP_TAC) THEN
      SIMP_TAC std_ss [GSPECIFICATION, PAIR_EQ, NOT_EXISTS_THM, EXISTS_PROD] THEN
      DISCH_THEN(MP_TAC o SPECL
       [``x:real``, ``i:real->bool``, ``l:real->bool``]) THEN
      ASM_SIMP_TAC std_ss [INTEGRAL_EMPTY, ABS_0]] THEN
    SUBGOAL_THEN
     ``{k INTER l | k IN d /\ l IN IMAGE SND (p:(real#(real->bool))->bool)} =
      IMAGE (\(k,l). k INTER l) {k,l | k IN d /\ l IN IMAGE SND p}``
    SUBST1_TAC THENL
     [GEN_REWR_TAC I [EXTENSION] THEN
      SIMP_TAC std_ss [GSPECIFICATION, IN_IMAGE, EXISTS_PROD, FORALL_PROD],
      ALL_TAC] THEN
    W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_NONZERO o rand o snd) THEN
    KNOW_TAC ``FINITE
   {(k,l) |
    k IN (d :(real -> bool) -> bool) /\
    l IN IMAGE (SND :real # (real -> bool) -> real -> bool)
      (p :real # (real -> bool) -> bool)} /\ (!(x :(real -> bool) # (real -> bool))
     (y :(real -> bool) # (real -> bool)). x IN {(k,l) | k IN d /\
     l IN IMAGE (SND :real # (real -> bool) -> real -> bool) p} /\
     y IN {(k,l) | k IN d /\
     l IN IMAGE (SND :real # (real -> bool) -> real -> bool) p} /\ x <> y /\
    ((\((k :real -> bool),(l :real -> bool)). k INTER l) x =
     (\((k :real -> bool),(l :real -> bool)). k INTER l) y) ==>
    ((\(k :real -> bool). abs (integral k (f :real -> real)))
       ((\((k :real -> bool),(l :real -> bool)). k INTER l) x) = (0 : real)))`` THENL
     [ASSUME_TAC(MATCH_MP DIVISION_OF_TAGGED_DIVISION
        (ASSUME ``p tagged_division_of interval[a:real,b]``)) THEN
      ASM_SIMP_TAC std_ss [FINITE_PRODUCT, IMAGE_FINITE] THEN
      SIMP_TAC std_ss [FORALL_PROD, IN_ELIM_PAIR_THM] THEN
      MAP_EVERY X_GEN_TAC
       [``l1:real->bool``, ``k1:real->bool``,
        ``l2:real->bool``, ``k2:real->bool``] THEN
      REWRITE_TAC [GSYM DE_MORGAN_THM] THEN STRIP_TAC THEN
      SUBGOAL_THEN ``interior(l2 INTER k2:real->bool) = {}`` MP_TAC THENL
       [ALL_TAC,
        MP_TAC(ASSUME ``d division_of interval[a:real,b]``) THEN
        REWRITE_TAC[division_of] THEN
        DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
        DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC o SPEC ``l2:real->bool``) K_TAC) THEN
        ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
        MP_TAC(ASSUME
         ``(IMAGE SND (p:(real#(real->bool))->bool))
                division_of interval[a:real,b]``) THEN
        REWRITE_TAC[division_of] THEN
        DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
        DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC o SPEC ``k2:real->bool``) K_TAC) THEN
        ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
        ASM_REWRITE_TAC[INTER_INTERVAL] THEN DISCH_TAC THEN
        REWRITE_TAC[ABS_ZERO] THEN
        MATCH_MP_TAC INTEGRAL_NULL THEN
        ASM_REWRITE_TAC[CONTENT_EQ_0_INTERIOR]] THEN
      MATCH_MP_TAC(SET_RULE
       ``((interior(k1) INTER interior(k2) = {}) \/
          (interior(l1) INTER interior(l2) = {})) /\
        interior(l1 INTER k1) SUBSET interior(k1) /\
        interior(l2 INTER k2) SUBSET interior(k2) /\
        interior(l1 INTER k1) SUBSET interior(l1) /\
        interior(l2 INTER k2) SUBSET interior(l2) /\
        (interior(l1 INTER k1) = interior(l2 INTER k2))
        ==> (interior(l2 INTER k2) = {})``) THEN
      SIMP_TAC std_ss [SUBSET_INTERIOR, INTER_SUBSET] THEN ASM_REWRITE_TAC[] THEN
      MP_TAC(ASSUME ``d division_of interval[a:real,b]``) THEN
      REWRITE_TAC[division_of] THEN
      DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
      DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
      DISCH_THEN (CONJUNCTS_THEN2 MP_TAC K_TAC) THEN
      DISCH_THEN(MP_TAC o SPECL [``l1:real->bool``, ``l2:real->bool``]) THEN
      ASM_REWRITE_TAC[] THEN
      MP_TAC(ASSUME
       ``(IMAGE SND (p:(real#(real->bool))->bool))
              division_of interval[a:real,b]``) THEN
      REWRITE_TAC[division_of] THEN
      DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
      DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
      DISCH_THEN (CONJUNCTS_THEN2 MP_TAC K_TAC) THEN
      DISCH_THEN(MP_TAC o SPECL [``k1:real->bool``, ``k2:real->bool``]) THEN
      ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    DISCH_THEN SUBST1_TAC THEN
    GEN_REWR_TAC (RAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN
    GEN_REWR_TAC (RAND_CONV o RAND_CONV) [LAMBDA_PROD] THEN
    ASM_SIMP_TAC std_ss [GSYM SUM_SUM_PRODUCT, IMAGE_FINITE] THEN
    MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN
    X_GEN_TAC ``k:real->bool`` THEN DISCH_TAC THEN REWRITE_TAC[o_DEF] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC
     ``sum { k INTER l |
             l IN IMAGE SND (p:(real#(real->bool))->bool)}
          (\k. abs(integral k (f:real->real)))`` THEN
    CONJ_TAC THENL
     [ALL_TAC,
      SIMP_TAC real_ss [GSYM IMAGE_DEF] THEN
      W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE_NONZERO o lhand o snd) THEN
      KNOW_TAC ``FINITE (IMAGE (SND :real # (real -> bool) -> real -> bool)
        (p :real # (real -> bool) -> bool)) /\
       (!(x :real -> bool) (y :real -> bool).
         x IN IMAGE (SND :real # (real -> bool) -> real -> bool) p /\
         y IN IMAGE (SND :real # (real -> bool) -> real -> bool) p /\ x <> y /\
      ((\(l :real -> bool). (k :real -> bool) INTER l) x =
       (\(l :real -> bool). k INTER l) y) ==>
      ((\(k :real -> bool). abs (integral k (f :real -> real)))
       ((\(l :real -> bool). k INTER l) x) = (0 : real)))`` THENL
      [ALL_TAC, DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
       SIMP_TAC std_ss [o_DEF, REAL_LE_REFL]] THEN
      ASM_SIMP_TAC std_ss [IMAGE_FINITE] THEN
      MAP_EVERY X_GEN_TAC [``k1:real->bool``, ``k2:real->bool``] THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      SUBGOAL_THEN ``interior(k INTER k2:real->bool) = {}`` MP_TAC THENL
       [ALL_TAC,
        MP_TAC(MATCH_MP DIVISION_OF_TAGGED_DIVISION
         (ASSUME ``p tagged_division_of interval[a:real,b]``)) THEN
        MP_TAC(ASSUME ``d division_of interval[a:real,b]``) THEN
        REWRITE_TAC[division_of] THEN
        DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
        DISCH_THEN (CONJUNCTS_THEN2 MP_TAC K_TAC) THEN
        DISCH_THEN(MP_TAC o SPEC ``k:real->bool``) THEN
        ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
        DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
        DISCH_THEN (CONJUNCTS_THEN2 MP_TAC K_TAC) THEN
        DISCH_THEN(MP_TAC o SPEC ``k2:real->bool``) THEN
        ASM_SIMP_TAC std_ss [INTER_INTERVAL, GSYM CONTENT_EQ_0_INTERIOR] THEN
        STRIP_TAC THEN ASM_REWRITE_TAC[INTER_INTERVAL] THEN
        SIMP_TAC std_ss [GSYM CONTENT_EQ_0_INTERIOR, INTEGRAL_NULL, ABS_0]] THEN
      MATCH_MP_TAC(SET_RULE
       ``interior(k INTER k2) SUBSET interior(k1 INTER k2) /\
        (interior(k1 INTER k2) = {})
        ==> (interior(k INTER k2) = {})``) THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC SUBSET_INTERIOR THEN ASM_SET_TAC[], ALL_TAC] THEN
      MP_TAC(MATCH_MP DIVISION_OF_TAGGED_DIVISION
         (ASSUME ``p tagged_division_of interval[a:real,b]``)) THEN
      REWRITE_TAC[division_of] THEN
      DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
      DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
      DISCH_THEN (CONJUNCTS_THEN2 MP_TAC K_TAC) THEN
      REWRITE_TAC[INTERIOR_INTER] THEN DISCH_THEN MATCH_MP_TAC THEN
      ASM_REWRITE_TAC[]] THEN
    SUBGOAL_THEN ``?u v:real. k = interval[u,v]``
     (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC)
    THENL [ASM_MESON_TAC[division_of], ALL_TAC] THEN
    SUBGOAL_THEN ``interval[u:real,v] SUBSET interval[a,b]`` ASSUME_TAC THENL
     [ASM_MESON_TAC[division_of], ALL_TAC] THEN SIMP_TAC std_ss [] THEN
    ABBREV_TAC ``d' =
        {interval[u,v] INTER l |l|
                l IN IMAGE SND (p:(real#(real->bool))->bool) /\
                ~(interval[u,v] INTER l = {})}`` THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC
     ``sum d' (\k. abs (integral k (f:real->real)))`` THEN
    CONJ_TAC THENL
     [ALL_TAC,
      MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN
      MATCH_MP_TAC SUM_SUPERSET THEN
      EXPAND_TAC "d'" THEN REWRITE_TAC[SUBSET_DEF, SET_RULE
       ``a IN {f x |x| x IN s /\ ~(f x = b)} <=>
        a IN {f x | x IN s} /\ ~(a = b)``] THEN
      SIMP_TAC std_ss [IMP_CONJ, INTEGRAL_EMPTY, ABS_0]] THEN
    SIMP_TAC std_ss [] THEN
    SUBGOAL_THEN ``d' division_of interval[u:real,v]`` ASSUME_TAC THENL
     [EXPAND_TAC "d'" THEN MATCH_MP_TAC DIVISION_INTER_1 THEN
      EXISTS_TAC ``interval[a:real,b]`` THEN
      ASM_SIMP_TAC std_ss [DIVISION_OF_TAGGED_DIVISION],
      ALL_TAC] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC ``abs(sum d' (\i. integral i (f:real->real)))`` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN
      MATCH_MP_TAC INTEGRAL_COMBINE_DIVISION_TOPDOWN THEN
      ASM_MESON_TAC[INTEGRABLE_ON_SUBINTERVAL],
      ALL_TAC] THEN
    MATCH_MP_TAC SUM_ABS_LE THEN
    SIMP_TAC std_ss [REAL_LE_REFL] THEN METIS_TAC[division_of],
    ALL_TAC] THEN
  FIRST_X_ASSUM SUBST_ALL_TAC THEN
  MATCH_MP_TAC EQ_TRANS THEN
  EXISTS_TAC ``sum {x,i INTER l | (x,l) IN p /\ i IN d}
                  (\(x,k:real->bool).
                      abs(content k) * abs((f:real->real) x))`` THEN
  CONJ_TAC THENL
   [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN
    CONJ_TAC THENL [SET_TAC[], ALL_TAC] THEN
    SIMP_TAC std_ss [FORALL_PROD] THEN
    MAP_EVERY X_GEN_TAC [``x:real``, ``i:real->bool``] THEN
    ASM_CASES_TAC ``i:real->bool = {}`` THEN
    ASM_SIMP_TAC std_ss [CONTENT_EMPTY, ABS_N, REAL_MUL_LZERO] THEN
    MATCH_MP_TAC(TAUT `(a <=> b) ==> a /\ ~b ==> c`) THEN
    SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN
    REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN
    SIMP_TAC std_ss [PAIR_EQ] THEN ASM_MESON_TAC[],
    ALL_TAC] THEN
  SUBGOAL_THEN
   ``{(x,i INTER l) | (x,l) IN (p:(real#(real->bool))->bool) /\ i IN d} =
    IMAGE (\((x,l),k). (x,k INTER l)) {(m,k) | m IN p /\ k IN d}``
  SUBST1_TAC THENL
   [GEN_REWR_TAC I [EXTENSION] THEN
    SIMP_TAC std_ss [GSPECIFICATION, IN_IMAGE, EXISTS_PROD, FORALL_PROD] THEN
    SIMP_TAC std_ss [PAIR_EQ] THEN METIS_TAC [],
    ALL_TAC] THEN
  W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_NONZERO o lhand o snd) THEN
  KNOW_TAC ``FINITE
   {(m,k) | m IN (p :real # (real -> bool) -> bool) /\
    k IN (d :(real -> bool) -> bool)} /\
   (!(x :(real # (real -> bool)) # (real -> bool))
     (y :(real # (real -> bool)) # (real -> bool)).
    x IN {(m,k) | m IN p /\ k IN d} /\
    y IN {(m,k) | m IN p /\ k IN d} /\ x <> y /\
    ((\(((x :real),(l :real -> bool)),(k :real -> bool)). (x,k INTER l))
       x = (\(((x :real),(l :real -> bool)),(k :real -> bool)). (x,k INTER l)) y) ==>
    ((\((x :real),(k :real -> bool)).
        abs (content k) * abs ((f :real -> real) x))
       ((\(((x :real),(l :real -> bool)),(k :real -> bool)).
           (x,k INTER l)) x) = (0 : real)))`` THENL
   [ASM_SIMP_TAC std_ss [FINITE_PRODUCT] THEN
    SIMP_TAC std_ss [FORALL_PROD, IN_ELIM_PAIR_THM] THEN
    MAP_EVERY X_GEN_TAC
     [``x1:real``, ``l1:real->bool``, ``k1:real->bool``,
      ``l2:real->bool``, ``k2:real->bool``] THEN
    SIMP_TAC std_ss [PAIR_EQ] THEN REWRITE_TAC [GSYM DE_MORGAN_THM] THEN
    STRIP_TAC THEN
    REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN
    REWRITE_TAC[ABS_ZERO] THEN
    SUBGOAL_THEN ``interior(k2 INTER l2:real->bool) = {}`` MP_TAC THENL
     [ALL_TAC,
      UNDISCH_TAC ``d division_of interval [(a,b)]`` THEN DISCH_TAC THEN
      FIRST_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
      DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
      DISCH_THEN (CONJUNCTS_THEN2 MP_TAC K_TAC) THEN
      DISCH_THEN(MP_TAC o SPEC ``k2:real->bool``) THEN
      ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      MP_TAC(ASSUME ``p tagged_division_of interval[a:real,b]``) THEN
      REWRITE_TAC[TAGGED_DIVISION_OF] THEN
      DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
      DISCH_THEN (CONJUNCTS_THEN2 MP_TAC K_TAC) THEN
      DISCH_THEN(MP_TAC o SPECL [``x1:real``, ``l2:real->bool``]) THEN
      ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
      ASM_SIMP_TAC std_ss [INTER_INTERVAL, CONTENT_EQ_0_INTERIOR]] THEN
    MATCH_MP_TAC(SET_RULE
     ``((interior(k1) INTER interior(k2) = {}) \/
        (interior(l1) INTER interior(l2) = {})) /\
      interior(k1 INTER l1) SUBSET interior(k1) /\
      interior(k2 INTER l2) SUBSET interior(k2) /\
      interior(k1 INTER l1) SUBSET interior(l1) /\
      interior(k2 INTER l2) SUBSET interior(l2) /\
      (interior(k1 INTER l1) = interior(k2 INTER l2))
      ==> (interior(k2 INTER l2) = {})``) THEN
    SIMP_TAC std_ss [SUBSET_INTERIOR, INTER_SUBSET] THEN ASM_REWRITE_TAC[] THEN
    UNDISCH_TAC ``d division_of interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
    DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
    DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
    DISCH_THEN (CONJUNCTS_THEN2 MP_TAC K_TAC) THEN
    DISCH_THEN(MP_TAC o SPECL [``k1:real->bool``, ``k2:real->bool``]) THEN
    MP_TAC(ASSUME ``p tagged_division_of interval[a:real,b]``) THEN
    REWRITE_TAC[TAGGED_DIVISION_OF] THEN
    DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
    DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
    DISCH_THEN (CONJUNCTS_THEN2 MP_TAC K_TAC) THEN
    DISCH_THEN(MP_TAC o SPECL
     [``x1:real``, ``l1:real->bool``, ``x1:real``, ``l2:real->bool``]) THEN
    ASM_SIMP_TAC std_ss [PAIR_EQ] THEN ASM_MESON_TAC[],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  DISCH_THEN SUBST1_TAC THEN
  GEN_REWR_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN
  GEN_REWR_TAC (LAND_CONV o RAND_CONV) [LAMBDA_PROD] THEN
  ASM_SIMP_TAC std_ss [GSYM SUM_SUM_PRODUCT] THEN
  MATCH_MP_TAC SUM_EQ THEN SIMP_TAC std_ss [FORALL_PROD] THEN
  MAP_EVERY X_GEN_TAC [``x:real``, ``l:real->bool``] THEN
  DISCH_TAC THEN SIMP_TAC std_ss [o_THM, SUM_RMUL] THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN
  SUBGOAL_THEN ``?u v:real. l = interval[u,v]``
   (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC)
  THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF], ALL_TAC] THEN
  MATCH_MP_TAC EQ_TRANS THEN
  EXISTS_TAC ``sum d (\k. content(k INTER interval[u:real,v]))`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[abs] THEN
    X_GEN_TAC ``k:real->bool`` THEN DISCH_TAC THEN
    SUBGOAL_THEN ``?w z:real. k = interval[w,z]``
      (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC)
    THENL [ASM_MESON_TAC[division_of], ALL_TAC] THEN
    SIMP_TAC std_ss [INTER_INTERVAL, CONTENT_POS_LE],
    ALL_TAC] THEN
  MATCH_MP_TAC EQ_TRANS THEN
  EXISTS_TAC ``sum {k INTER interval[u:real,v] | k IN d} content`` THEN
  CONJ_TAC THENL
   [SIMP_TAC real_ss [GSYM IMAGE_DEF] THEN SIMP_TAC std_ss [GSYM o_DEF] THEN
    CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_IMAGE_NONZERO THEN
    ASM_SIMP_TAC std_ss [] THEN
    MAP_EVERY X_GEN_TAC [``k1:real->bool``, ``k2:real->bool``] THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    SUBGOAL_THEN ``interior(k2 INTER interval[u:real,v]) = {}`` MP_TAC THENL
     [ALL_TAC,
      UNDISCH_TAC ``d division_of interval [(a,b)]`` THEN DISCH_TAC THEN
      FIRST_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
      DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
      DISCH_THEN (CONJUNCTS_THEN2 MP_TAC K_TAC) THEN
      DISCH_THEN(MP_TAC o SPEC ``k2:real->bool``) THEN
      ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      ASM_REWRITE_TAC[INTER_INTERVAL, CONTENT_EQ_0_INTERIOR]] THEN
    MATCH_MP_TAC(SET_RULE
     ``interior(k2 INTER i) SUBSET interior(k1 INTER k2) /\
      (interior(k1 INTER k2) = {})
      ==> (interior(k2 INTER i) = {})``) THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC SUBSET_INTERIOR THEN ASM_SET_TAC[], ALL_TAC] THEN
    UNDISCH_TAC ``d division_of interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
    DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
    DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
    DISCH_THEN (CONJUNCTS_THEN2 MP_TAC K_TAC) THEN
    SIMP_TAC std_ss [INTERIOR_INTER] THEN DISCH_THEN MATCH_MP_TAC THEN
    ASM_REWRITE_TAC[],
    ALL_TAC] THEN
  SUBGOAL_THEN ``interval[u:real,v] SUBSET interval[a,b]`` ASSUME_TAC THENL
   [ASM_MESON_TAC[TAGGED_DIVISION_OF], ALL_TAC] THEN
  MATCH_MP_TAC EQ_TRANS THEN
  EXISTS_TAC ``sum {k INTER interval[u:real,v] |k|
                      k IN d /\ ~(k INTER interval[u,v] = {})} content`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC SUM_SUPERSET THEN
    SIMP_TAC std_ss [SUBSET_DEF, SET_RULE
     ``a IN {f x |x| x IN s /\ ~(f x = b)} <=>
       a IN {f x | x IN s} /\ ~(a = b)``] THEN
    SIMP_TAC std_ss [IMP_CONJ, CONTENT_EMPTY],
    ALL_TAC] THEN
  MATCH_MP_TAC ADDITIVE_CONTENT_DIVISION THEN
  ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC DIVISION_INTER_1 THEN
  EXISTS_TAC ``interval[a:real,b]`` THEN ASM_REWRITE_TAC[]
QED

val BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE = store_thm ("BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE",
 ``!f:real->real.
        f integrable_on UNIV /\
        (\k. integral k f) has_bounded_setvariation_on univ(:real)
        ==> f absolutely_integrable_on UNIV``,
  REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_UNIV] THEN
  REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[absolutely_integrable_on] THEN
  MP_TAC(ISPEC ``IMAGE (\d. sum d (\k. abs(integral k (f:real->real))))
                      {d | d division_of (BIGUNION d) }``
         SUP) THEN
  SIMP_TAC std_ss [FORALL_IN_IMAGE, IMAGE_EQ_EMPTY] THEN
  SIMP_TAC std_ss [GSYM MEMBER_NOT_EMPTY, GSPECIFICATION] THEN
  ABBREV_TAC
   ``i = sup (IMAGE (\d. sum d (\k. abs(integral k (f:real->real))))
                      {d | d division_of (BIGUNION d) })`` THEN
  KNOW_TAC ``(?(x :(real -> bool) -> bool). x division_of BIGUNION x) /\
 (?(b :real). !(d :(real -> bool) -> bool).
      d division_of BIGUNION d ==>
      sum d (\(k :real -> bool). abs (integral k (f :real -> real))) <= b)`` THENL
   [CONJ_TAC THENL [ALL_TAC, ASM_MESON_TAC[]] THEN
    EXISTS_TAC ``{}:(real->bool)->bool`` THEN
    REWRITE_TAC[BIGUNION_EMPTY, DIVISION_OF_TRIVIAL],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  STRIP_TAC THEN REWRITE_TAC[integrable_on] THEN EXISTS_TAC ``i:real`` THEN
  REWRITE_TAC[HAS_INTEGRAL_ALT, IN_UNIV] THEN
  MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
   [MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN
    MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``b:real``]
      (REWRITE_RULE[HAS_BOUNDED_SETVARIATION_ON_INTERVAL]
       BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE_INTERVAL)) THEN
    KNOW_TAC ``(f :real -> real) integrable_on interval [((a :real),(b :real))] /\
 (?(B :real). !(d :(real -> bool) -> bool).
      d division_of interval [(a,b)] ==>
      sum d (\(k :real -> bool).
           abs ((\(k :real -> bool). integral k f) k)) <= B)`` THENL
    [ALL_TAC, DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
     SIMP_TAC std_ss [absolutely_integrable_on]] THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC ``univ(:real)`` THEN
      ASM_REWRITE_TAC[SUBSET_UNIV],
      ALL_TAC] THEN
    EXISTS_TAC ``B:real`` THEN REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIVISION_OF_UNION_SELF],
    ALL_TAC] THEN
  SIMP_TAC std_ss [] THEN
  DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  UNDISCH_TAC ``!b.
        (!d. d division_of BIGUNION d ==>
           sum d (\k. abs (integral k f)) <= b) ==>
        i <= b`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``i - e:real``) THEN
  ASM_SIMP_TAC std_ss [REAL_ARITH ``&0 < e ==> ~(i <= i - e:real)``] THEN
  SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP, REAL_NOT_LE, LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC ``d:(real->bool)->bool`` THEN STRIP_TAC THEN
  SUBGOAL_THEN ``bounded(BIGUNION d:real->bool)`` MP_TAC THENL
   [ASM_MESON_TAC[ELEMENTARY_BOUNDED], ALL_TAC] THEN
  REWRITE_TAC[BOUNDED_POS] THEN
  DISCH_THEN(X_CHOOSE_THEN ``kk:real`` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC ``kk + &1:real`` THEN ASM_SIMP_TAC std_ss [REAL_LT_ADD, REAL_LT_01] THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN DISCH_TAC THEN
  SIMP_TAC std_ss [] THEN
  MATCH_MP_TAC(REAL_ARITH
   ``!s1. i - e < s1 /\ s1 <= s /\ s < i + e ==> abs(s - i) < e:real``) THEN
  EXISTS_TAC ``sum (d:(real->bool)->bool) (\k. abs (integral k
                    (f:real->real)))`` THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
  ASM_SIMP_TAC std_ss [] THEN CONJ_TAC THENL
   [MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC ``sum d
      (\k. integral k (\x. abs((f:real->real) x)))`` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC SUM_LE THEN
      UNDISCH_TAC ``d division_of BIGUNION d`` THEN DISCH_TAC THEN
      FIRST_ASSUM(fn t => ASM_SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION t]) THEN
      REPEAT STRIP_TAC THEN SIMP_TAC std_ss [] THEN
      MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_LE THEN
      ASM_SIMP_TAC std_ss [absolutely_integrable_on] THEN
      MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN
      EXISTS_TAC ``univ(:real)`` THEN ASM_REWRITE_TAC[SUBSET_UNIV],
      ALL_TAC] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC ``integral (BIGUNION d)
                      (\x. abs((f:real->real) x))`` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC(METIS[REAL_LE_LT]
       ``(x = y) ==> x <= y:real``) THEN
      ASM_SIMP_TAC std_ss [o_DEF] THEN CONV_TAC SYM_CONV THEN
      MATCH_MP_TAC INTEGRAL_COMBINE_DIVISION_BOTTOMUP THEN
      FIRST_ASSUM(fn t => ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION t]),
      ALL_TAC] THEN
    MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN
    ASM_SIMP_TAC std_ss [ABS_POS] THEN
    MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
     [MATCH_MP_TAC SUBSET_TRANS THEN
      EXISTS_TAC ``ball(0:real,kk + &1)`` THEN
      ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET_DEF, IN_BALL, dist] THEN
      ASM_SIMP_TAC std_ss [REAL_ARITH ``abs(x) <= kk ==> abs(0 - x) < kk + &1:real``],
      ALL_TAC] THEN
    DISCH_TAC THEN SIMP_TAC std_ss [] THEN
    MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN
    EXISTS_TAC ``interval[a:real,b]`` THEN
    EXISTS_TAC ``d:(real->bool)->bool`` THEN ASM_REWRITE_TAC[],
    ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [``a:real``, ``b:real``]) THEN
  REWRITE_TAC[HAS_INTEGRAL_INTEGRAL, has_integral] THEN
  DISCH_THEN(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN ``d1:real->real->bool`` MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC) THEN
  MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``b:real``]
                HENSTOCK_LEMMA) THEN
  KNOW_TAC ``(f :real -> real) integrable_on interval [((a :real),(b :real))]`` THENL
   [MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN
    EXISTS_TAC ``univ(:real)`` THEN ASM_SIMP_TAC std_ss [SUBSET_UNIV],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  DISCH_THEN(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN ``d2:real->real->bool`` MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC) THEN
  SUBGOAL_THEN ``?p. p tagged_division_of interval[a:real,b] /\
                    d1 FINE p /\ d2 FINE p``
  STRIP_ASSUME_TAC THENL
   [REWRITE_TAC[GSYM FINE_INTER] THEN MATCH_MP_TAC FINE_DIVISION_EXISTS THEN
    ASM_SIMP_TAC std_ss [GAUGE_INTER],
    ALL_TAC] THEN FULL_SIMP_TAC std_ss [] THEN
  UNDISCH_TAC `` !p'. p' tagged_division_of interval [(a,b)] /\ d1 FINE p' ==>
    abs (sum p' (\(x,k). content k * abs (f x)) -
     integral (interval [(a,b)]) (\x. abs (f x))) < e / 2`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM (MP_TAC o SPEC ``p:(real#(real->bool)->bool)``) THEN
  FIRST_X_ASSUM (MP_TAC o SPEC ``p:(real#(real->bool)->bool)``) THEN
  ASM_SIMP_TAC std_ss [] THEN
  KNOW_TAC ``p tagged_partial_division_of interval [(a,b)]`` THENL
   [METIS_TAC[tagged_division_of],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  SIMP_TAC std_ss [LAMBDA_PAIR] THEN
  ONCE_REWRITE_TAC [METIS []
   ``(\p. abs (content (SND p) * f (FST p) - integral (SND p) f)) =
     (\p. abs ((\p. content (SND p) * f (FST p)) p - (\p. integral (SND p) f) p))``] THEN
 DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
  ASM_SIMP_TAC std_ss [o_DEF, SUM_SUB] THEN
  SIMP_TAC std_ss [LAMBDA_PROD, ABS_MUL] THEN
  GEN_REWR_TAC (RAND_CONV o RAND_CONV o RAND_CONV o RAND_CONV) [GSYM REAL_HALF] THEN
  MATCH_MP_TAC(REAL_ARITH
   ``(sf' = sf) /\ si <= i
    ==> abs(sf - si) < e / &2
        ==> abs(sf' - di) < e / &2
            ==> di < i + (e / 2 + e / 2:real)``) THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC SUM_EQ THEN SIMP_TAC std_ss [FORALL_PROD, abs] THEN
    METIS_TAC[CONTENT_POS_LE, TAGGED_DIVISION_OF],
    ALL_TAC] THEN
  SUBGOAL_THEN
   ``sum p (\(x:real,k). abs(integral k f)) =
    sum (IMAGE SND p) (\k. abs(integral k (f:real->real)))``
  SUBST1_TAC THENL
   [ONCE_REWRITE_TAC [METIS [] ``(\(x,k). abs (integral k f)) =
                             (\(x,k).(\k. abs(integral k (f:real->real))) k)``] THEN
    MATCH_MP_TAC SUM_OVER_TAGGED_DIVISION_LEMMA THEN
    EXISTS_TAC ``interval[a:real,b]`` THEN ASM_SIMP_TAC std_ss [] THEN
    SIMP_TAC std_ss [INTEGRAL_NULL, ABS_0],
    ALL_TAC] THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN
  MATCH_MP_TAC PARTIAL_DIVISION_OF_TAGGED_DIVISION THEN
  EXISTS_TAC ``interval[a:real,b]`` THEN ASM_MESON_TAC[tagged_division_of]);

val ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_UNIV_EQ = store_thm ("ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_UNIV_EQ",
 ``!f:real->real.
        f absolutely_integrable_on univ(:real) <=>
        f integrable_on univ(:real) /\
        (\k. integral k f) has_bounded_setvariation_on univ(:real)``,
  GEN_TAC THEN EQ_TAC THEN
  SIMP_TAC std_ss [ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION,
           BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE,
           ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]);

val ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_EQ = store_thm ("ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_EQ",
 ``!f:real->real a b.
        f absolutely_integrable_on interval[a,b] <=>
        f integrable_on interval[a,b] /\
        (\k. integral k f) has_bounded_setvariation_on interval[a,b]``,
  REPEAT GEN_TAC THEN EQ_TAC THEN
  SIMP_TAC std_ss [ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION,
           BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE_INTERVAL,
           ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]);

val ABSOLUTELY_INTEGRABLE_SET_VARIATION = store_thm ("ABSOLUTELY_INTEGRABLE_SET_VARIATION",
 ``!f:real->real a b.
        f absolutely_integrable_on interval[a,b]
        ==> (set_variation (interval[a,b]) (\k. integral k f) =
                  integral (interval[a,b]) (\x. abs(f x)))``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[set_variation] THEN
  MATCH_MP_TAC REAL_SUP_UNIQUE THEN
  SIMP_TAC std_ss [FORALL_IN_GSPEC, EXISTS_IN_GSPEC] THEN CONJ_TAC THENL
   [X_GEN_TAC ``d:(real->bool)->bool`` THEN
    DISCH_THEN(X_CHOOSE_THEN ``s:real->bool`` STRIP_ASSUME_TAC) THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC ``integral s (\x. abs((f:real->real) x))`` THEN
    CONJ_TAC THENL
     [MP_TAC(ISPECL [``\x. abs((f:real->real) x)``,
                     ``d:(real->bool)->bool``, ``s:real->bool``]
        INTEGRAL_COMBINE_DIVISION_TOPDOWN) THEN
      ASM_SIMP_TAC std_ss [] THEN
      KNOW_TAC ``(\(x :real). abs ((f :real -> real) x)) integrable_on
                 (s :real -> bool)`` THENL
       [RULE_ASSUM_TAC(REWRITE_RULE[absolutely_integrable_on]) THEN
        ASM_REWRITE_TAC[] THEN
        MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN
        EXISTS_TAC ``interval[a:real,b]`` THEN ASM_MESON_TAC[],
        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
        DISCH_THEN SUBST1_TAC] THEN
      FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
      ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC SUM_LE THEN
      ASM_REWRITE_TAC[o_THM] THEN
      REPEAT STRIP_TAC THEN BETA_TAC THEN MATCH_MP_TAC INTEGRAL_ABS_BOUND_INTEGRAL THEN
      SIMP_TAC std_ss [REAL_LE_REFL, GSYM absolutely_integrable_on] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN
      ASM_MESON_TAC[ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL, SUBSET_TRANS],
      MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN
      ASM_SIMP_TAC std_ss [ABS_POS] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[absolutely_integrable_on]) THEN
      ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN
      EXISTS_TAC ``interval[a:real,b]`` THEN ASM_MESON_TAC[]],
    X_GEN_TAC ``B:real`` THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
    ABBREV_TAC ``e = integral (interval [a,b]) (\x. abs((f:real->real) x)) - B`` THEN
    DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN
    DISCH_THEN(MP_TAC o SPEC ``e / &2:real`` o MATCH_MP HENSTOCK_LEMMA) THEN
    ASM_REWRITE_TAC[REAL_HALF] THEN
    DISCH_THEN(X_CHOOSE_THEN ``d1:real->real->bool``
     (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN
    UNDISCH_TAC ``f absolutely_integrable_on interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o REWRITE_RULE [absolutely_integrable_on]) THEN
    DISCH_THEN(MP_TAC o CONJUNCT2) THEN
    REWRITE_TAC[HAS_INTEGRAL_INTEGRAL, has_integral] THEN
    DISCH_THEN(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
    DISCH_THEN(X_CHOOSE_THEN ``d2:real->real->bool``
     (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN
    MP_TAC(ISPECL
     [``\x. (d1:real->real->bool) x INTER d2 x``,
      ``a:real``, ``b:real``]
     FINE_DIVISION_EXISTS) THEN
    ASM_SIMP_TAC std_ss [GAUGE_INTER, FINE_INTER] THEN
    DISCH_THEN(X_CHOOSE_THEN ``p:real#(real->bool)->bool``
        STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM (MP_TAC o SPEC  ``p:real#(real->bool)->bool``) THEN
    FIRST_X_ASSUM (MP_TAC o SPEC  ``p:real#(real->bool)->bool``) THEN
    ASM_SIMP_TAC std_ss [] THEN
    KNOW_TAC ``p tagged_partial_division_of interval [(a,b)]`` THENL
    [ASM_MESON_TAC[tagged_division_of],
     DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    MP_TAC(ISPECL
     [``\x. abs((f:real->real) x)``,
      ``a:real``, ``b:real``, ``p:real#(real->bool)->bool``]
      INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN) THEN
     KNOW_TAC ``(\(x :real). abs ((f :real -> real) x)) integrable_on
      interval [((a :real),(b :real))] /\
       (p :real # (real -> bool) -> bool) tagged_division_of
      interval [(a,b)]`` THENL
     [RULE_ASSUM_TAC(SIMP_RULE std_ss [absolutely_integrable_on]) THEN
      ASM_REWRITE_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
      POP_ASSUM K_TAC THEN DISCH_THEN SUBST_ALL_TAC] THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
    DISCH_TAC THEN
    SUBGOAL_THEN
     ``abs(sum p (\(x,k). content k * abs((f:real->real) x)) -
          sum p (\(x,k:real->bool). abs(integral k f))) < e / &2``
    MP_TAC THENL
     [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        REAL_LET_TRANS)) THEN
      ASM_SIMP_TAC std_ss [GSYM SUM_SUB] THEN MATCH_MP_TAC SUM_ABS_LE THEN
      ASM_SIMP_TAC std_ss [FORALL_PROD] THEN REPEAT STRIP_TAC THEN
      MATCH_MP_TAC(REAL_ARITH
       ``(x = abs u) ==> abs(x - abs v) <= abs(u - v:real)``) THEN
      SIMP_TAC std_ss [ABS_MUL, abs] THEN
      METIS_TAC[CONTENT_POS_LE, TAGGED_DIVISION_OF],
      ALL_TAC] THEN
    ASM_SIMP_TAC std_ss [] THEN
    SIMP_TAC std_ss [LAMBDA_PROD, o_DEF, AND_IMP_INTRO] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
     ``abs(x - y:real) < e / &2 /\ abs(x - z) < e / &2
      ==> abs(y - z) < e / 2 + e / 2``)) THEN
    REWRITE_TAC[REAL_HALF] THEN
    DISCH_THEN(MP_TAC o SPEC ``B:real`` o MATCH_MP
     (REAL_ARITH ``!B. abs(x - y) < e ==> (y - B = e) ==> &0 < x - B:real``)) THEN
    ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC std_ss [REAL_SUB_LT] THEN
    SIMP_TAC std_ss [o_DEF, LAMBDA_PROD] THEN DISCH_TAC THEN
    EXISTS_TAC ``IMAGE SND (p:real#(real->bool)->bool)`` THEN CONJ_TAC THENL
     [EXISTS_TAC ``interval[a:real,b]`` THEN
      ASM_SIMP_TAC std_ss [DIVISION_OF_TAGGED_DIVISION, SUBSET_REFL],
      FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        SUM_OVER_TAGGED_DIVISION_LEMMA)) THEN
      DISCH_THEN(fn th =>
       W(MP_TAC o PART_MATCH (rand o rand) th o rand o snd)) THEN
      SIMP_TAC std_ss [INTEGRAL_NULL, ABS_0] THEN
      DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]]]);

val ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV = store_thm ("ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV",
 ``!f s. (\x. if x IN s then f x else 0)
              absolutely_integrable_on univ(:real) <=>
         f absolutely_integrable_on s``,
  SIMP_TAC std_ss [absolutely_integrable_on, INTEGRABLE_RESTRICT_UNIV,
              COND_RAND, ABS_0]);

val ABSOLUTELY_INTEGRABLE_CONST = store_thm ("ABSOLUTELY_INTEGRABLE_CONST",
 ``!a b c. (\x. c) absolutely_integrable_on interval[a,b]``,
  REWRITE_TAC[absolutely_integrable_on, INTEGRABLE_CONST]);

val ABSOLUTELY_INTEGRABLE_ADD = store_thm ("ABSOLUTELY_INTEGRABLE_ADD",
 ``!f:real->real g s.
        f absolutely_integrable_on s /\
        g absolutely_integrable_on s
        ==> (\x. f(x) + g(x)) absolutely_integrable_on s``,
  SUBGOAL_THEN
   ``!f:real->real g.
        f absolutely_integrable_on univ(:real) /\
        g absolutely_integrable_on univ(:real)
        ==> (\x. f(x) + g(x)) absolutely_integrable_on univ(:real)``
  ASSUME_TAC THENL
   [ALL_TAC,
    ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN
    REPEAT GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN
    SIMP_TAC std_ss [] THEN MATCH_MP_TAC EQ_IMPLIES THEN
    AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
    GEN_TAC THEN SIMP_TAC std_ss [] THEN
    COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [REAL_ADD_LID]] THEN
  REPEAT STRIP_TAC THEN
  EVERY_ASSUM(STRIP_ASSUME_TAC o
   REWRITE_RULE [absolutely_integrable_on]) THEN
  MATCH_MP_TAC BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE THEN
  ASM_SIMP_TAC std_ss [INTEGRABLE_ADD] THEN
  MP_TAC(ISPECL [``g:real->real``, ``univ(:real)``]
     ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION) THEN
  MP_TAC(ISPECL [``f:real->real``, ``univ(:real)``]
     ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION) THEN
  ASM_SIMP_TAC std_ss [HAS_BOUNDED_SETVARIATION_ON_UNIV] THEN
  DISCH_THEN(X_CHOOSE_TAC ``B1:real``) THEN
  DISCH_THEN(X_CHOOSE_TAC ``B2:real``) THEN EXISTS_TAC ``B1 + B2:real`` THEN
  X_GEN_TAC ``d:(real->bool)->bool`` THEN DISCH_TAC THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC ``d:(real->bool)->bool``)) THEN
  ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
   ``a <= B1 ==> x <= a + B2 ==> x <= B1 + B2:real``)) THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
   ``b <= B2 ==> x <= a + b ==> x <= a + B2:real``)) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
  ASM_SIMP_TAC std_ss [GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN
  UNDISCH_TAC ``d division_of BIGUNION d`` THEN DISCH_TAC THEN
  FIRST_ASSUM(fn t => ASM_SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION t]) THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN STRIP_TAC THEN
  MATCH_MP_TAC(REAL_ARITH ``(x = y + z) ==> abs(x) <= abs(y) + abs(z:real)``) THEN
  MATCH_MP_TAC INTEGRAL_ADD THEN CONJ_TAC THEN
  MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN
  EXISTS_TAC ``univ(:real)`` THEN ASM_REWRITE_TAC[SUBSET_UNIV]);

val ABSOLUTELY_INTEGRABLE_SUB = store_thm ("ABSOLUTELY_INTEGRABLE_SUB",
 ``!f:real->real g s.
        f absolutely_integrable_on s /\
        g absolutely_integrable_on s
        ==> (\x. f(x) - g(x)) absolutely_integrable_on s``,
  REWRITE_TAC[real_sub] THEN
  SIMP_TAC std_ss [ABSOLUTELY_INTEGRABLE_ADD, ABSOLUTELY_INTEGRABLE_NEG]);

val ABSOLUTELY_INTEGRABLE_LINEAR = store_thm ("ABSOLUTELY_INTEGRABLE_LINEAR",
 ``!f:real->real h:real->real s.
        f absolutely_integrable_on s /\ linear h
        ==> (h o f) absolutely_integrable_on s``,
  SUBGOAL_THEN
   ``!f:real->real h:real->real.
        f absolutely_integrable_on univ(:real) /\ linear h
        ==> (h o f) absolutely_integrable_on univ(:real)``
  ASSUME_TAC THENL
   [ALL_TAC,
    ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN
    REPEAT GEN_TAC THEN DISCH_THEN(fn th =>
     ANTE_RES_THEN MP_TAC th THEN
     ASSUME_TAC(MATCH_MP LINEAR_0 (CONJUNCT2 th))) THEN
    ASM_SIMP_TAC std_ss [o_DEF, COND_RAND]] THEN
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE THEN
  FIRST_ASSUM(MP_TAC o
    MATCH_MP ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[absolutely_integrable_on]) THEN
  ASM_SIMP_TAC std_ss [INTEGRABLE_LINEAR, HAS_BOUNDED_SETVARIATION_ON_UNIV] THEN
  FIRST_ASSUM(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC o MATCH_MP
              LINEAR_BOUNDED_POS) THEN
  DISCH_THEN(X_CHOOSE_TAC ``b:real``) THEN EXISTS_TAC ``B * b:real`` THEN
  X_GEN_TAC ``d:(real->bool)->bool`` THEN DISCH_TAC THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC ``B * sum d (\k. abs(integral k (f:real->real)))`` THEN
  ASM_SIMP_TAC std_ss [REAL_LE_LMUL] THEN SIMP_TAC std_ss [GSYM SUM_LMUL] THEN
  MATCH_MP_TAC SUM_LE THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
  FIRST_ASSUM(fn t => ASM_SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION t]) THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b':real``] THEN DISCH_TAC THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC ``abs(h(integral (interval[a,b']) (f:real->real)):real)`` THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN
  MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_LINEAR THEN
  ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL] THEN
  MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN
  EXISTS_TAC ``univ(:real)`` THEN ASM_REWRITE_TAC[SUBSET_UNIV]);

val ABSOLUTELY_INTEGRABLE_SUM = store_thm ("ABSOLUTELY_INTEGRABLE_SUM",
 ``!f:'a->real->real s t.
        FINITE t /\
        (!a. a IN t ==> (f a) absolutely_integrable_on s)
        ==>  (\x. sum t (\a. f a x)) absolutely_integrable_on s``,
  GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
  ONCE_REWRITE_TAC [METIS []
   ``( (!a. a IN t ==> f a absolutely_integrable_on s) ==>
   (\x. sum t (\a. f a x)) absolutely_integrable_on s) =
   (\t. (!a. a IN t ==> f a absolutely_integrable_on s) ==>
  ( \x. sum t (\a. f a x)) absolutely_integrable_on s) t``] THEN
  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
  SIMP_TAC std_ss [GSYM RIGHT_FORALL_IMP_THM] THEN
  SIMP_TAC std_ss [SUM_CLAUSES, ABSOLUTELY_INTEGRABLE_0, IN_INSERT] THEN
  REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC [METIS [] ``(\x. f e x + sum s' (\a. f a x)) =
                  (\x. (\x. f e x) x + (\x. sum s' (\a. f a x)) x)``] THEN
  MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ADD THEN METIS_TAC [ETA_AX]);

Theorem ABSOLUTELY_INTEGRABLE_MAX :
    !f:real->real g:real->real s.
        f absolutely_integrable_on s /\ g absolutely_integrable_on s
        ==> (\x. (max (f(x)) (g(x))):real)
            absolutely_integrable_on s
Proof
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_SUB) THEN
  DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_ABS) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_ADD) THEN
  REWRITE_TAC[AND_IMP_INTRO] THEN
  DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_ADD) THEN
  DISCH_THEN(MP_TAC o SPEC ``inv(&2:real)`` o
     MATCH_MP ABSOLUTELY_INTEGRABLE_CMUL) THEN
  MATCH_MP_TAC EQ_IMPLIES THEN SIMP_TAC std_ss [] THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN
  REWRITE_TAC[FUN_EQ_THM] THEN
  SIMP_TAC std_ss [max_def] THEN REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN REWRITE_TAC [GSYM real_div] THEN
  SIMP_TAC std_ss [REAL_EQ_LDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
  Cases_on `f x <= g x` >> rw [] >> REAL_ASM_ARITH_TAC
QED

Theorem ABSOLUTELY_INTEGRABLE_MIN :
    !f:real->real g:real->real s.
        f absolutely_integrable_on s /\ g absolutely_integrable_on s
        ==> (\x. (min (f(x)) (g(x))):real)
            absolutely_integrable_on s
Proof
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_SUB) THEN
  DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_ABS) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_ADD) THEN
  REWRITE_TAC[AND_IMP_INTRO] THEN
  DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_SUB) THEN
  DISCH_THEN(MP_TAC o SPEC ``inv(&2:real)`` o
     MATCH_MP ABSOLUTELY_INTEGRABLE_CMUL) THEN
  MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN AP_TERM_TAC THEN
  REWRITE_TAC[FUN_EQ_THM] THEN
  SIMP_TAC std_ss [min_def] THEN REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN REWRITE_TAC [GSYM real_div] THEN
  SIMP_TAC std_ss [REAL_EQ_LDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
  Cases_on `f x <= g x` >> rw [] >> REAL_ASM_ARITH_TAC
QED

val ABSOLUTELY_INTEGRABLE_ABS_EQ = store_thm ("ABSOLUTELY_INTEGRABLE_ABS_EQ",
 ``!f:real->real s.
        f absolutely_integrable_on s <=>
          f integrable_on s /\
          (\x. (abs(f(x))):real) integrable_on s``,
  REPEAT GEN_TAC THEN EQ_TAC THEN
  SIMP_TAC std_ss [ABSOLUTELY_INTEGRABLE_ABS,
           ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN
  SUBGOAL_THEN
   ``!f:real->real.
        f integrable_on univ(:real) /\
        (\x. (abs(f(x))):real) integrable_on univ(:real)
        ==> f absolutely_integrable_on univ(:real)``
  ASSUME_TAC THENL
   [ALL_TAC,
    ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV,
                     GSYM INTEGRABLE_RESTRICT_UNIV] THEN
    DISCH_THEN(fn th => FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN
    MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMPLIES THEN
    AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
    SIMP_TAC std_ss [] THEN REPEAT STRIP_TAC THEN
    ASM_SIMP_TAC std_ss [] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[ABS_0]] THEN
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE THEN
  ASM_REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_UNIV] THEN
  EXISTS_TAC
   ``sum ((1:num)..(1:num))
        (\i. integral univ(:real)
              (\x. (abs ((f:real->real) x)):real))`` THEN
  X_GEN_TAC ``d:(real->bool)->bool`` THEN DISCH_TAC THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC ``sum d (\k. sum ((1:num)..(1:num))
      (\i. integral k
              (\x. (abs ((f:real->real) x)):real)))`` THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN CONJ_TAC THENL
   [MATCH_MP_TAC SUM_LE THEN
    UNDISCH_TAC ``d division_of BIGUNION d`` THEN DISCH_TAC THEN
    FIRST_ASSUM(fn t => ASM_SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION t]) THEN
    MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN DISCH_TAC THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC ``sum ((1:num)..(1:num))
             (\i. abs((integral (interval[a,b]) (f:real->real))))`` THEN
    REWRITE_TAC[ABS_LE_L1] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN
    X_GEN_TAC ``k:num`` THEN STRIP_TAC THEN SIMP_TAC std_ss [] THEN
    MATCH_MP_TAC(REAL_ARITH ``x <= y /\ -x <= y ==> abs(x) <= y:real``) THEN
    ASM_SIMP_TAC std_ss [] THEN
    SUBGOAL_THEN ``(f:real->real) integrable_on interval[a,b] /\
        (\x. (abs (f x)):real) integrable_on interval[a,b]``
    STRIP_ASSUME_TAC THENL
     [CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN
      EXISTS_TAC ``univ(:real)`` THEN ASM_REWRITE_TAC[SUBSET_UNIV],
      ALL_TAC] THEN
    ASM_SIMP_TAC std_ss [GSYM INTEGRAL_NEG] THEN
    CONJ_TAC THEN MATCH_MP_TAC INTEGRAL_COMPONENT_LE THEN
    ASM_SIMP_TAC std_ss [INTEGRABLE_NEG] THEN
    REPEAT STRIP_TAC THEN REAL_ARITH_TAC,
    ALL_TAC] THEN
  ONCE_REWRITE_TAC [METIS [] ``(\i. integral k (\x. abs (f x))) =
                          (\k. (\i. integral k (\x. abs (f x)))) k``] THEN
  W(MP_TAC o PART_MATCH (lhs o rand) SUM_SWAP o lhand o snd) THEN
  ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST_ALL_TAC THEN
  MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC ``k:num`` THEN STRIP_TAC THEN
  SIMP_TAC std_ss [] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC
   ``(integral (BIGUNION d) (\x. (abs ((f:real->real) x)):real))`` THEN
  CONJ_TAC THENL
   [ASM_SIMP_TAC std_ss [] THEN
    MATCH_MP_TAC REAL_EQ_IMP_LE THEN
    CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMBINE_DIVISION_TOPDOWN THEN
    ASM_REWRITE_TAC[],
    MATCH_MP_TAC INTEGRAL_SUBSET_COMPONENT_LE THEN
    ASM_SIMP_TAC std_ss [SUBSET_UNIV, ABS_POS]] THEN
  MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN
  MAP_EVERY EXISTS_TAC [``univ(:real)``, ``d:(real->bool)->bool``] THEN
  ASM_REWRITE_TAC[SUBSET_UNIV]);

val NONNEGATIVE_ABSOLUTELY_INTEGRABLE = store_thm ("NONNEGATIVE_ABSOLUTELY_INTEGRABLE",
 ``!f:real->real s.
        (!x i. x IN s ==> &0 <= f(x)) /\
        f integrable_on s
        ==> f absolutely_integrable_on s``,
  SIMP_TAC std_ss [ABSOLUTELY_INTEGRABLE_ABS_EQ] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_EQ THEN
  EXISTS_TAC ``f:real->real`` THEN
  ASM_SIMP_TAC std_ss [abs]);

val ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND = store_thm ("ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND",
 ``!f:real->real g s.
        (!x. x IN s ==> abs(f x) <= (g x)) /\
        f integrable_on s /\ g integrable_on s
        ==> f absolutely_integrable_on s``,
  SUBGOAL_THEN
   ``!f:real->real g.
        (!x. abs(f x) <= (g x)) /\
        f integrable_on univ(:real) /\ g integrable_on univ(:real)
        ==> f absolutely_integrable_on univ(:real)``
  ASSUME_TAC THENL
   [ALL_TAC,
    ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV, GSYM
                     ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN
    REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    EXISTS_TAC ``(\x. if x IN s then g x else 0):real->real`` THEN
    ASM_SIMP_TAC std_ss [] THEN GEN_TAC THEN COND_CASES_TAC THEN
    ASM_SIMP_TAC std_ss [REAL_LE_REFL, ABS_0]] THEN
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE THEN
  ASM_REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_UNIV] THEN
  EXISTS_TAC ``integral univ(:real) g`` THEN
  X_GEN_TAC ``d:(real->bool)->bool`` THEN DISCH_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC ``sum d (\k. (integral k (g:real->real)))`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN
    UNDISCH_TAC ``d division_of BIGUNION d`` THEN DISCH_TAC THEN
    FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
    REPEAT STRIP_TAC THEN
    MATCH_MP_TAC INTEGRAL_ABS_BOUND_INTEGRAL THEN ASM_REWRITE_TAC[] THEN
    CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN
    EXISTS_TAC ``univ(:real)`` THEN ASM_REWRITE_TAC[SUBSET_UNIV],
    ALL_TAC] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC ``(integral (BIGUNION d:real->bool) g)`` THEN CONJ_TAC THENL
   [MATCH_MP_TAC(REAL_ARITH ``(x = y:real) ==> y <= x``) THEN
    ASM_SIMP_TAC std_ss [o_DEF] THEN
    MATCH_MP_TAC INTEGRAL_COMBINE_DIVISION_BOTTOMUP THEN
    FIRST_ASSUM(fn th => ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN
    REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN
    EXISTS_TAC ``univ(:real)`` THEN ASM_REWRITE_TAC[SUBSET_UNIV],
    MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN
    ASM_REWRITE_TAC[SUBSET_UNIV, IN_UNIV] THEN CONJ_TAC THENL
     [ALL_TAC, ASM_MESON_TAC[REAL_ARITH ``abs(x) <= y ==> &0 <= y:real``]] THEN
    MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN
    MAP_EVERY EXISTS_TAC [``univ(:real)``, ``d:(real->bool)->bool``] THEN
    ASM_REWRITE_TAC[SUBSET_UNIV]]);

val ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_BOUND = store_thm ("ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_BOUND",
 ``!f:real->real g:real->real s.
        (!x. x IN s ==> abs(f x) <= abs(g x)) /\
        f integrable_on s /\ g absolutely_integrable_on s
        ==> f absolutely_integrable_on s``,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE
    [absolutely_integrable_on]) THEN
  MP_TAC(ISPECL
   [``f:real->real``, ``(\x. abs((g:real->real) x))``,
    ``s:real->bool``] ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND) THEN
  ASM_SIMP_TAC std_ss []);

val ABSOLUTELY_INTEGRABLE_INF = store_thm ("ABSOLUTELY_INTEGRABLE_INF",
 ``!fs s:real->bool k:'a->bool.
        FINITE k /\ ~(k = {}) /\
        (!i. i IN k ==> (\x. (fs x i)) absolutely_integrable_on s)
        ==> (\x. (inf (IMAGE (fs x) k))) absolutely_integrable_on s``,
  GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
  ONCE_REWRITE_TAC [METIS []
   ``!k. (k <> {} ==>
  (!i. i IN k ==> (\x. fs x i) absolutely_integrable_on s) ==>
  (\x. inf (IMAGE (fs x) k)) absolutely_integrable_on s) =
     (\k. k <> {} ==>
  (!i. i IN k ==> (\x. fs x i) absolutely_integrable_on s) ==>
  (\x. inf (IMAGE (fs x) k)) absolutely_integrable_on s) k``] THEN
  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
  SIMP_TAC std_ss [IMAGE_EMPTY, IMAGE_INSERT] THEN
  SIMP_TAC std_ss [GSYM RIGHT_FORALL_IMP_THM] THEN
  SIMP_TAC std_ss [INF_INSERT_FINITE, IMAGE_FINITE, IMAGE_EQ_EMPTY] THEN
  MAP_EVERY X_GEN_TAC [``k:'a->bool``, ``a:'a``] THEN
  ASM_CASES_TAC ``k:'a->bool = {}`` THEN ASM_REWRITE_TAC[] THEN
  SIMP_TAC std_ss [IN_SING, LEFT_FORALL_IMP_THM, EXISTS_REFL] THEN
  REWRITE_TAC[AND_IMP_INTRO, GSYM CONJ_ASSOC] THEN REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC [METIS [] ``(\(x :real).
   min ((fs :real -> 'a -> real) x (a :'a))
     (inf (IMAGE (fs x) (k :'a -> bool)))) =
   (\x. min ((\x. fs x a) x) ((\x. inf (IMAGE (fs x) k)) x))``] THEN
  MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MIN THEN
  CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INSERT] THEN
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_REWRITE_TAC[IN_INSERT]);

val ABSOLUTELY_INTEGRABLE_SUP = store_thm ("ABSOLUTELY_INTEGRABLE_SUP",
 ``!fs s:real->bool k:'a->bool.
        FINITE k /\ ~(k = {}) /\
        (!i. i IN k ==> (\x. (fs x i)) absolutely_integrable_on s)
        ==> (\x. (sup (IMAGE (fs x) k))) absolutely_integrable_on s``,
  GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
  ONCE_REWRITE_TAC [METIS []
   ``!k. (k <> {} ==>
  (!i. i IN k ==> (\x. fs x i) absolutely_integrable_on s) ==>
  (\x. sup (IMAGE (fs x) k)) absolutely_integrable_on s) =
     (\k. k <> {} ==>
  (!i. i IN k ==> (\x. fs x i) absolutely_integrable_on s) ==>
  (\x. sup (IMAGE (fs x) k)) absolutely_integrable_on s) k``] THEN
  MATCH_MP_TAC FINITE_INDUCT THEN SIMP_TAC std_ss [IMAGE_EMPTY, IMAGE_INSERT] THEN
  SIMP_TAC std_ss [GSYM RIGHT_FORALL_IMP_THM] THEN
  SIMP_TAC std_ss [SUP_INSERT_FINITE, IMAGE_FINITE, IMAGE_EQ_EMPTY] THEN
  MAP_EVERY X_GEN_TAC [``k:'a->bool``, ``a:'a``] THEN
  ASM_CASES_TAC ``k:'a->bool = {}`` THEN ASM_REWRITE_TAC[] THEN
  SIMP_TAC std_ss [IN_SING, LEFT_FORALL_IMP_THM, EXISTS_REFL] THEN
  REWRITE_TAC[AND_IMP_INTRO, GSYM CONJ_ASSOC] THEN REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC [METIS []
   ``(\x. max ((fs :real -> 'a -> real) x a) (sup (IMAGE (fs x) k))) =
     (\x. max ((\x. fs x a) x) ((\x. sup (IMAGE (fs x) k)) x))``] THEN
  MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX THEN
  CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INSERT] THEN
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_REWRITE_TAC[IN_INSERT]);

val ABSOLUTELY_INTEGRABLE_CONTINUOUS = store_thm ("ABSOLUTELY_INTEGRABLE_CONTINUOUS",
 ``!f:real->real a b.
        f continuous_on interval[a,b]
        ==> f absolutely_integrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN
  SUBGOAL_THEN ``compact(IMAGE (f:real->real) (interval[a,b]))`` MP_TAC THENL
   [ASM_SIMP_TAC std_ss [COMPACT_CONTINUOUS_IMAGE, COMPACT_INTERVAL], ALL_TAC] THEN
  DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN
  SIMP_TAC std_ss [BOUNDED_POS, FORALL_IN_IMAGE] THEN
  DISCH_THEN(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC ``\x:real. (B:real)`` THEN
  ASM_SIMP_TAC std_ss [INTEGRABLE_CONST, INTEGRABLE_CONTINUOUS]);

Theorem INTEGRABLE_MIN_CONST :
    !f s t.
        &0 <= t /\ (!x. x IN s ==> &0 <= f x) /\
        (\x:real. (f x)) integrable_on s
        ==> (\x. (min (f x) t)) integrable_on s
Proof
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND THEN
  EXISTS_TAC ``\x:real. (f x):real`` THEN ASM_SIMP_TAC std_ss [] THEN CONJ_TAC THENL
  [ (* goal 1 (of 2) *)
    REPEAT GEN_TAC THEN
    MP_TAC(ISPECL
     [``\x:real. if x IN s then f x else &0:real``,
      ``(\x. t):real->real``,
      ``interval[a:real,b]``] ABSOLUTELY_INTEGRABLE_MIN) THEN
    SIMP_TAC std_ss [] THEN
    KNOW_TAC ``(\(x :real).
     if x IN (s :real -> bool) then (f :real -> real) x
     else (0 :real)) absolutely_integrable_on
      interval [((a :real),(b :real))] /\
      (\(x :real). (t :real)) absolutely_integrable_on interval [(a,b)]`` THENL
    [ (* goal 1.1 (of 2) *)
      SIMP_TAC std_ss [ABSOLUTELY_INTEGRABLE_CONTINUOUS, CONTINUOUS_ON_CONST] THEN
      MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN
      EXISTS_TAC ``univ(:real)`` THEN SIMP_TAC std_ss [SUBSET_UNIV] THEN
      SIMP_TAC std_ss [COND_RAND] THEN
      REWRITE_TAC[ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN
      MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN
      ASM_SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
      METIS_TAC[AND_IMP_INTRO, ETA_AX],
      (* goal 1.2 (of 2) *)
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
      DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN
      MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN AP_TERM_TAC THEN
      REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN SIMP_TAC std_ss [] THEN
      COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [] THEN
      REWRITE_TAC [min_def] THEN fs [] ],
    (* goal 2 (of 2) *)
    X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN
    RW_TAC real_ss [min_def] >> ASM_REAL_ARITH_TAC ]
QED

val ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND = store_thm ("ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND",
 ``!f:real->real g:real->real s.
        (!x i. x IN s ==> f(x) <= g(x)) /\
        f integrable_on s /\ g absolutely_integrable_on s
        ==> f absolutely_integrable_on s``,
  REPEAT STRIP_TAC THEN SUBGOAL_THEN
   ``(\x. (g:real->real)(x) - (g(x) - f(x))) absolutely_integrable_on s``
  MP_TAC THENL
   [ONCE_REWRITE_TAC [METIS [] ``(\x. g x - (g x - f x:real)) =
                            (\x. g x - (\x. (g x - f x)) x)``] THEN
    MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN
    ASM_SIMP_TAC std_ss [REAL_SUB_LE] THEN
    MATCH_MP_TAC INTEGRABLE_SUB THEN
    ASM_SIMP_TAC std_ss [ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE],
    SIMP_TAC std_ss[REAL_ARITH ``x - (x - y):real = y``, ETA_AX]]);

val ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND = store_thm ("ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND",
 ``!f:real->real g:real->real s.
        (!x i. x IN s ==> f(x) <= g(x)) /\
        f absolutely_integrable_on s /\ g integrable_on s
        ==> g absolutely_integrable_on s``,
  REPEAT STRIP_TAC THEN SUBGOAL_THEN
   ``(\x. (f:real->real)(x) + (g(x) - f(x))) absolutely_integrable_on s``
  MP_TAC THENL
   [ONCE_REWRITE_TAC [METIS [] ``(\x. f x + (g x - f x:real)) =
                            (\x. f x + (\x. (g x - f x)) x)``] THEN
    MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ADD THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN
    ASM_SIMP_TAC std_ss [REAL_SUB_LE] THEN
    MATCH_MP_TAC INTEGRABLE_SUB THEN
    ASM_SIMP_TAC std_ss [ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE],
    SIMP_TAC std_ss [REAL_ARITH ``y + (x - y):real = x``, ETA_AX]]);

val ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_UBOUND = store_thm ("ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_UBOUND",
 ``!f:real->real g:real->real s.
        (!x. x IN s ==> f(x) <= g(x)) /\
        f integrable_on s /\ g absolutely_integrable_on s
        ==> f absolutely_integrable_on s``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC
    ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND THEN
  EXISTS_TAC ``g:real->real`` THEN
  ASM_SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
  ASM_SIMP_TAC std_ss [AND_IMP_INTRO]);

val ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_LBOUND = store_thm ("ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_LBOUND",
 ``!f:real->real g:real->real s.
        (!x. x IN s ==> f(x) <= g(x)) /\
        f absolutely_integrable_on s /\ g integrable_on s
        ==> g absolutely_integrable_on s``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC
    ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND THEN
  EXISTS_TAC ``f:real->real`` THEN
  ASM_SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
  ASM_SIMP_TAC std_ss [AND_IMP_INTRO]);

(* ------------------------------------------------------------------------- *)
(* Relating vector integrals to integrals of components.                     *)
(* ------------------------------------------------------------------------- *)

val HAS_INTEGRAL_COMPONENTWISE = store_thm ("HAS_INTEGRAL_COMPONENTWISE",
 ``!f:real->real s y.
        (f has_integral y) s <=> ((\x. (f x)) has_integral (y)) s``,
  METIS_TAC [ETA_AX]);

val INTEGRABLE_COMPONENTWISE = store_thm ("INTEGRABLE_COMPONENTWISE",
 ``!f:real->real s.
        f integrable_on s <=>
         (\x. (f x)) integrable_on s``,
   METIS_TAC [ETA_AX]);

val INTEGRAL_COMPONENT = store_thm ("INTEGRAL_COMPONENT",
 ``!f:real->real s.
        f integrable_on s
        ==> ((integral s f) = integral s (\x. (f x)))``,
  METIS_TAC [ETA_AX]);

val ABSOLUTELY_INTEGRABLE_COMPONENTWISE = store_thm ("ABSOLUTELY_INTEGRABLE_COMPONENTWISE",
 ``!f:real->real s.
     f absolutely_integrable_on s <=>
      ((\x. (f x)) absolutely_integrable_on s)``,
  METIS_TAC [ETA_AX]);

(* ------------------------------------------------------------------------- *)
(* Dominated convergence.                                                    *)
(* ------------------------------------------------------------------------- *)

val DOMINATED_CONVERGENCE = store_thm ("DOMINATED_CONVERGENCE",
 ``!f:num->real->real g h s.
        (!k. (f k) integrable_on s) /\ h integrable_on s /\
        (!k x. x IN s ==> abs(f k x) <= (h x)) /\
        (!x. x IN s ==> ((\k. f k x) --> g x) sequentially)
        ==> g integrable_on s /\
            ((\k. integral s (f k)) --> integral s g) sequentially``,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MP_TAC(GEN ``m:num``
   (ISPECL [``\k:num x:real. inf {(f j x) | j IN (m..(m+k))}``,
            ``\x:real. inf {(f j x) | m:num <= j}``,
            ``s:real->bool``]
           MONOTONE_CONVERGENCE_DECREASING)) THEN SIMP_TAC std_ss [] THEN
   KNOW_TAC ``!m. ((!(k :num).
    (\(x :real).
       inf
         {(f :num -> real -> real) j x |
          j IN (m :num) .. m + k}) integrable_on (s :real -> bool)) /\
 (!(k :num) (x :real).
    x IN s ==>
    inf {f j x | j IN m .. m + SUC k} <=
    inf {f j x | j IN m .. m + k}) /\
 (!(x :real).
    x IN s ==>
    (((\(k :num). inf {f j x | j IN m .. m + k}) -->
      inf {f j x | m <= j}) sequentially :bool)) /\
 (bounded
    {integral s (\(x :real). inf {f j x | j IN m .. m + k}) |
     k IN univ((:num) :num itself)} :bool))`` THENL (* 2 goals *)
   [X_GEN_TAC ``m:num`` THEN REPEAT CONJ_TAC THENL (* 4 goals *)
     [GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
      SIMP_TAC real_ss [GSYM IMAGE_DEF] THEN
      ONCE_REWRITE_TAC [METIS [] ``(\j. f j x) = (\x. (\j. f j x)) x``] THEN
      MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INF THEN
      SIMP_TAC std_ss [FINITE_NUMSEG, NUMSEG_EMPTY, NOT_LESS, LE_ADD] THEN
      ASM_SIMP_TAC std_ss [METIS [ETA_AX] ``(\x. f i x) = f i``] THEN
      REPEAT STRIP_TAC THEN
      MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN
      EXISTS_TAC ``h:real->real`` THEN ASM_REWRITE_TAC[],

      REPEAT STRIP_TAC THEN SIMP_TAC real_ss [GSYM IMAGE_DEF] THEN
      MATCH_MP_TAC REAL_LE_INF_SUBSET THEN
      SIMP_TAC std_ss [IMAGE_EQ_EMPTY, NUMSEG_EMPTY, NOT_LESS, LE_ADD] THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC IMAGE_SUBSET THEN
        REWRITE_TAC[SUBSET_NUMSEG] THEN ARITH_TAC,
        ALL_TAC] THEN
      SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN
      ONCE_REWRITE_TAC [METIS []
      ``(b <= (f:num->real->real) j x) <=> b <= (\j. f j x) j``] THEN
      MATCH_MP_TAC LOWER_BOUND_FINITE_SET_REAL THEN
      REWRITE_TAC[FINITE_NUMSEG],

      X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
      REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
      REWRITE_TAC[dist] THEN
      MP_TAC(SPEC ``{((f:num->real->real) j x) | m <= j}`` INF) THEN
      ABBREV_TAC ``i = inf {(f:num->real->real) j x | m <= j}`` THEN
      ONCE_REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN] ``{(f:num->real->real) j x | m <= j} =
                                    IMAGE (\j. f j x) {j | m <= j}``] THEN
      SIMP_TAC std_ss [FORALL_IN_IMAGE, EXISTS_IN_IMAGE, IMAGE_EQ_EMPTY] THEN
      SIMP_TAC std_ss [GSPECIFICATION, EXTENSION, NOT_IN_EMPTY] THEN
      KNOW_TAC ``(?(x :num). (m :num) <= x) /\ (?(b :real).
       !(j :num). m <= j ==> b <= (f :num -> real -> real) j (x :real))`` THENL
       [CONJ_TAC THENL [METIS_TAC[LESS_EQ_REFL], ALL_TAC] THEN
        EXISTS_TAC ``-(h(x:real)):real`` THEN X_GEN_TAC ``j:num`` THEN
        FIRST_X_ASSUM(MP_TAC o SPECL [``j:num``, ``x:real``]) THEN
        ASM_SIMP_TAC std_ss [] THEN REAL_ARITH_TAC,
        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC ``i + e:real``)) THEN
      ASM_SIMP_TAC std_ss [REAL_ARITH ``&0 < e ==> ~(i + e <= i:real)``] THEN
      SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP, REAL_NOT_LE] THEN
      DISCH_THEN (X_CHOOSE_TAC ``M:num``) THEN EXISTS_TAC ``M:num`` THEN
      X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN
      UNDISCH_TAC ``m <= M /\ (f:num->real->real) M x < i + e`` THEN STRIP_TAC THEN
      FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
       ``y < i + e ==> i <= ix /\ ix <= y ==> abs(ix - i) < e:real``)) THEN
      CONJ_TAC THENL
       [EXPAND_TAC "i" THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN
        ONCE_REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN]
        ``{(f:num->real->real) j x | j IN t} =
           IMAGE (\j. f j x) {j | j IN t}``] THEN
        SIMP_TAC std_ss [IMAGE_EQ_EMPTY, SET_RULE ``{x | x IN s} = s``] THEN
        SIMP_TAC std_ss [NUMSEG_EMPTY, NOT_LESS, LE_ADD] THEN
        ONCE_REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN]
        ``{(f:num->real->real) j x | m <= j} =
           IMAGE (\j. f j x) {j | m <= j}``] THEN
        CONJ_TAC THENL
         [MATCH_MP_TAC IMAGE_SUBSET THEN
          SIMP_TAC std_ss [SUBSET_DEF, IN_NUMSEG, GSPECIFICATION] THEN ARITH_TAC,
          SIMP_TAC std_ss [FORALL_IN_IMAGE, GSPECIFICATION] THEN ASM_MESON_TAC[]],
        ALL_TAC] THEN
      W(MP_TAC o C SPEC INF o rand o lhand o snd) THEN
      KNOW_TAC ``{(f :num -> real -> real) j (x :real) |
           j IN (m :num) .. m + (n :num)} <> ({} :real -> bool) /\
         (?(b :real). !(x' :real). x' IN {f j x | j IN m .. m + n} ==> b <= x')`` THENL
       [ONCE_REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN]
        ``{(f:num->real->real) j x | j IN t} =
           IMAGE (\j. f j x) {j | j IN t}``] THEN
        SIMP_TAC std_ss [IMAGE_EQ_EMPTY, SET_RULE ``{x | x IN s} = s``] THEN
        REWRITE_TAC[NUMSEG_EMPTY, NOT_LESS, LE_ADD] THEN
        SIMP_TAC std_ss [FORALL_IN_IMAGE, GSPECIFICATION] THEN
        EXISTS_TAC ``i:real`` THEN GEN_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN
        DISCH_THEN(fn th => FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN
        ARITH_TAC,
        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
      SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN
      DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN
      SIMP_TAC std_ss [GSPECIFICATION, IN_NUMSEG] THEN
      EXISTS_TAC ``M:num`` THEN ASM_SIMP_TAC arith_ss [],

      REWRITE_TAC[bounded_def] THEN
      EXISTS_TAC ``integral s (h:real->real)`` THEN
      SIMP_TAC real_ss [GSYM IMAGE_DEF] THEN
      SIMP_TAC std_ss [FORALL_IN_IMAGE, IN_UNIV] THEN
      X_GEN_TAC ``p:num`` THEN MATCH_MP_TAC INTEGRAL_ABS_BOUND_INTEGRAL THEN
      ASM_SIMP_TAC std_ss [] THEN CONJ_TAC THENL
       [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
        SIMP_TAC real_ss [GSYM IMAGE_DEF] THEN
        ONCE_REWRITE_TAC [METIS [] ``(\j. f j x) = (\x. (\j. f j x)) x``] THEN
        MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INF THEN
        SIMP_TAC std_ss [FINITE_NUMSEG, NUMSEG_EMPTY, NOT_LESS, LE_ADD] THEN
        ASM_REWRITE_TAC[METIS [ETA_AX] ``(\x. f i x) = f i``] THEN REPEAT STRIP_TAC THEN
        MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN
        EXISTS_TAC ``h:real->real`` THEN ASM_SIMP_TAC std_ss [],
        ALL_TAC] THEN
      X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
      SIMP_TAC std_ss [] THEN
      MATCH_MP_TAC REAL_ABS_INF_LE THEN SIMP_TAC real_ss [GSYM IMAGE_DEF] THEN
      SIMP_TAC std_ss [FORALL_IN_IMAGE, IMAGE_EQ_EMPTY] THEN
      ASM_SIMP_TAC std_ss [NUMSEG_EMPTY, NOT_LESS, LE_ADD] ],

    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    SIMP_TAC std_ss [FORALL_AND_THM] THEN STRIP_TAC ] THEN
  MP_TAC(GEN ``m:num``
    (ISPECL [``\k:num x:real. sup {(f j x) | j IN (m..(m+k))}``,
            ``\x:real. sup {(f j x) | m:num <= j}``,
            ``s:real->bool``]
           MONOTONE_CONVERGENCE_INCREASING)) THEN
  SIMP_TAC std_ss [] THEN
  KNOW_TAC ``!m. ((!(k :num).
    (\(x :real).
       sup
         {(f :num -> real -> real) j x |
          j IN (m :num) .. m + k}) integrable_on (s :real -> bool)) /\
   (!(k :num) (x :real). x IN s ==>
    sup {f j x | j IN m .. m + k} <=
    sup {f j x | j IN m .. m + SUC k}) /\
   (!(x :real). x IN s ==>
    (((\(k :num). sup {f j x | j IN m .. m + k}) -->
      sup {f j x | m <= j}) sequentially :bool)) /\
   (bounded {integral s (\(x :real). sup {f j x | j IN m .. m + k}) |
     k IN univ((:num) :num itself)} :bool))`` THENL
   [POP_ASSUM K_TAC THEN POP_ASSUM K_TAC THEN GEN_TAC THEN REPEAT CONJ_TAC THENL
     [GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
      SIMP_TAC real_ss [GSYM IMAGE_DEF] THEN
      ONCE_REWRITE_TAC [METIS [] ``(\j. f j x) = (\x. (\j. f j x)) x``] THEN
      MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUP THEN
      SIMP_TAC std_ss [FINITE_NUMSEG, NUMSEG_EMPTY, NOT_LESS, LE_ADD] THEN
      ASM_REWRITE_TAC[METIS [ETA_AX] ``(\x. f i x) = f i``] THEN
      REPEAT STRIP_TAC THEN
      MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN
      EXISTS_TAC ``h:real->real`` THEN ASM_REWRITE_TAC[],
      REPEAT STRIP_TAC THEN SIMP_TAC real_ss [GSYM IMAGE_DEF] THEN
      MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN
      SIMP_TAC std_ss [IMAGE_EQ_EMPTY, NUMSEG_EMPTY, NOT_LESS, LE_ADD] THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC IMAGE_SUBSET THEN
        REWRITE_TAC[SUBSET_NUMSEG] THEN ARITH_TAC,
        ALL_TAC] THEN
      SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN
      ONCE_REWRITE_TAC [METIS [] ``(((f:num->real->real) j x) <= b) =
                                             (((\j. f j x) j) <= b)``] THEN
      MATCH_MP_TAC UPPER_BOUND_FINITE_SET_REAL THEN
      REWRITE_TAC[FINITE_NUMSEG],
      X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
      REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
      REWRITE_TAC[dist] THEN
      MP_TAC(SPEC ``{(f:num->real->real) j x | m <= j}`` SUP) THEN
      ABBREV_TAC ``i = sup {(f:num->real->real) j x | m <= j}`` THEN
      ONCE_REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN]
      ``{(f:num->real->real) j x | m <= j} =
        IMAGE (\j. (f:num->real->real) j x) {j | m <= j}``] THEN
      SIMP_TAC std_ss [FORALL_IN_IMAGE, EXISTS_IN_IMAGE, IMAGE_EQ_EMPTY] THEN
      SIMP_TAC std_ss [GSPECIFICATION, EXTENSION, NOT_IN_EMPTY] THEN
      KNOW_TAC ``(?(x :num). (m :num) <= x) /\ (?(b :real).
      !(j :num). m <= j ==> (f :num -> real -> real) j (x :real) <= b)`` THENL
       [CONJ_TAC THENL [MESON_TAC[LESS_EQ_REFL], ALL_TAC] THEN
        EXISTS_TAC ``(h (x:real)):real`` THEN X_GEN_TAC ``j:num`` THEN
        FIRST_X_ASSUM(MP_TAC o SPECL [``j:num``, ``x:real``]) THEN
        ASM_SIMP_TAC std_ss [] THEN REAL_ARITH_TAC,
        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC ``i - e:real``)) THEN
      ASM_SIMP_TAC std_ss [REAL_ARITH ``&0:real < e ==> ~(i <= i - e)``] THEN
      SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP, REAL_NOT_LE] THEN
      DISCH_THEN (X_CHOOSE_TAC ``M:num``) THEN EXISTS_TAC ``M:num`` THEN
      X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN
      UNDISCH_TAC `` m <= M /\ i - e < (f:num->real->real) M x`` THEN STRIP_TAC THEN
      FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
       ``i - e < y ==> ix <= i /\ y <= ix ==> abs(ix - i) < e:real``)) THEN
      CONJ_TAC THENL
       [EXPAND_TAC "i" THEN MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN
        ONCE_REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN]
        ``{(f:num->real->real) j x | j IN t} =
          IMAGE (\j. f j x) {j | j IN t}``] THEN
        SIMP_TAC std_ss [IMAGE_EQ_EMPTY, SET_RULE ``{x | x IN s} = s``] THEN
        REWRITE_TAC[NUMSEG_EMPTY, NOT_LESS, LE_ADD] THEN
        ONCE_REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN]
        ``{(f:num->real->real) j x | m <= j} =
           IMAGE (\j. f j x) {j | m <= j}``] THEN CONJ_TAC THENL
         [MATCH_MP_TAC IMAGE_SUBSET THEN
          SIMP_TAC std_ss [SUBSET_DEF, IN_NUMSEG, GSPECIFICATION] THEN ARITH_TAC,
          SIMP_TAC std_ss [FORALL_IN_IMAGE, GSPECIFICATION] THEN ASM_MESON_TAC[]],
        ALL_TAC] THEN
      W(MP_TAC o C SPEC SUP o rand o rand o snd) THEN
      KNOW_TAC ``{(f:num->real->real) j x | j IN m .. m + n} <> {} /\
       (?b. !x'. x' IN {f j x | j IN m .. m + n} ==> x' <= b)`` THENL
       [ONCE_REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN]
        ``{(f:num->real->real) j x | j IN t} =
          IMAGE (\j. f j x) {j | j IN t}``] THEN
        SIMP_TAC std_ss [IMAGE_EQ_EMPTY, SET_RULE ``{x | x IN s} = s``] THEN
        REWRITE_TAC[NUMSEG_EMPTY, NOT_LESS, LE_ADD] THEN
        SIMP_TAC std_ss [FORALL_IN_IMAGE, GSPECIFICATION] THEN
        EXISTS_TAC ``i:real`` THEN GEN_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN
        DISCH_THEN(fn th => FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN
        ARITH_TAC, DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
      SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN
      DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN
      SIMP_TAC std_ss [GSPECIFICATION, IN_NUMSEG] THEN
      EXISTS_TAC ``M:num`` THEN ASM_SIMP_TAC arith_ss [],
      REWRITE_TAC[bounded_def] THEN
      EXISTS_TAC ``integral s (h:real->real)`` THEN
      SIMP_TAC real_ss [GSYM IMAGE_DEF] THEN
      SIMP_TAC std_ss [FORALL_IN_IMAGE, IN_UNIV] THEN
      X_GEN_TAC ``p:num`` THEN MATCH_MP_TAC INTEGRAL_ABS_BOUND_INTEGRAL THEN
      ASM_SIMP_TAC std_ss [] THEN CONJ_TAC THENL
       [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
        SIMP_TAC real_ss [GSYM IMAGE_DEF] THEN
        ONCE_REWRITE_TAC [METIS [] ``(\j. f j x) = (\x. (\j. f j x)) x``] THEN
        MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUP THEN
        SIMP_TAC std_ss [FINITE_NUMSEG, NUMSEG_EMPTY, NOT_LESS, LE_ADD] THEN
        ASM_REWRITE_TAC[METIS [ETA_AX] ``(\x. f i x) = f i``] THEN REPEAT STRIP_TAC THEN
        MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN
        EXISTS_TAC ``h:real->real`` THEN ASM_REWRITE_TAC[],
        ALL_TAC] THEN
      X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
      MATCH_MP_TAC REAL_ABS_SUP_LE THEN SIMP_TAC real_ss [GSYM IMAGE_DEF] THEN
      SIMP_TAC std_ss [FORALL_IN_IMAGE, IMAGE_EQ_EMPTY] THEN
      ASM_SIMP_TAC std_ss [NUMSEG_EMPTY, NOT_LESS, LE_ADD]],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    SIMP_TAC std_ss [FORALL_AND_THM] THEN STRIP_TAC] THEN
  MP_TAC(ISPECL
   [``\k:num x:real. inf {(f j x) | k <= j}``,
    ``g:real->real``,
    ``s:real->bool``]
           MONOTONE_CONVERGENCE_INCREASING) THEN
  ASM_SIMP_TAC std_ss [] THEN
  KNOW_TAC ``(!(k :num) (x :real). x IN s ==>
   inf {(f:num->real->real) j x | k <= j} <= inf {f j x | SUC k <= j}) /\
   (!(x :real). x IN s ==>
    (((\(k :num). inf {f j x | k <= j}) --> (g :real -> real) x)
       sequentially :bool)) /\
   (bounded {integral s (\(x :real). inf {f j x | k <= j}) |
     k IN univ((:num) :num itself)} :bool)`` THENL

   [ONCE_REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN] ``{(f:num->real->real) j x | m <= j} =
                                    IMAGE (\j. f j x) {j | m <= j}``] THEN
    CONJ_TAC THENL
     [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN
      SIMP_TAC real_ss [IMAGE_EQ_EMPTY, SET_RULE ``{x | x IN s} = s``] THEN
      SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, NOT_IN_EMPTY, NOT_LESS_EQUAL] THEN
      CONJ_TAC THENL [EXISTS_TAC ``k + 1:num`` THEN ARITH_TAC, ALL_TAC] THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC IMAGE_SUBSET THEN
        SIMP_TAC std_ss [SUBSET_DEF, IN_NUMSEG, GSPECIFICATION] THEN ARITH_TAC,
        ALL_TAC] THEN
      SIMP_TAC std_ss [FORALL_IN_IMAGE, GSPECIFICATION] THEN
      EXISTS_TAC ``-(h(x:real)):real`` THEN REPEAT STRIP_TAC THEN
      MATCH_MP_TAC(REAL_ARITH ``abs(x) <= a ==> -a <= x:real``) THEN
      ASM_SIMP_TAC std_ss [],
      ALL_TAC] THEN
    CONJ_TAC THENL
     [X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN ASM_SIMP_TAC std_ss [] THEN
      SIMP_TAC std_ss [LIM_SEQUENTIALLY] THEN
      DISCH_THEN(fn th => X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
                 MP_TAC(SPEC ``e / &2:real`` th)) THEN
      ASM_REWRITE_TAC[REAL_HALF] THEN
      DISCH_THEN (X_CHOOSE_TAC ``M:num``) THEN EXISTS_TAC ``M:num`` THEN
      POP_ASSUM MP_TAC THEN REWRITE_TAC[dist] THEN
      STRIP_TAC THEN X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN
      GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF] THEN
      MATCH_MP_TAC(REAL_ARITH
      ``&0 < e / 2 /\ x <= e / &2 ==> x < e / 2 + e / 2:real``) THEN
      ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC REAL_INF_ASCLOSE THEN
      SIMP_TAC std_ss [IMAGE_EQ_EMPTY, FORALL_IN_IMAGE, GSPECIFICATION] THEN
      CONJ_TAC THENL [ALL_TAC, METIS_TAC[LESS_EQ_TRANS, REAL_LT_IMP_LE]] THEN
      SIMP_TAC std_ss [EXTENSION, NOT_IN_EMPTY, GSPECIFICATION, NOT_FORALL_THM] THEN
      MESON_TAC[LESS_EQ_REFL],
      ALL_TAC] THEN
    ONCE_REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN]
     ``{integral s (\x. inf (IMAGE (\j. (f:num->real->real) j x)
                                        {j | k <= j})) | k IN t} =
        IMAGE (\k. integral s (\x. inf (IMAGE (\j. (f:num->real->real) j x)
                                    {j | k <= j}))) {k | k IN t}``] THEN
    SIMP_TAC std_ss [bounded_def, FORALL_IN_IMAGE, GSPECIFICATION, IN_UNIV] THEN
    EXISTS_TAC ``(integral s (h:real->real))`` THEN
    X_GEN_TAC ``p:num`` THEN MATCH_MP_TAC INTEGRAL_ABS_BOUND_INTEGRAL THEN
    ASM_SIMP_TAC real_ss [GSYM SIMPLE_IMAGE_GEN] THEN X_GEN_TAC ``x:real`` THEN
    DISCH_TAC THEN MATCH_MP_TAC REAL_ABS_INF_LE THEN
    ONCE_REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN] ``{(f:num->real->real) j x | m <= j} =
                                    IMAGE (\j. f j x) {j | m <= j}``] THEN
    SIMP_TAC std_ss [FORALL_IN_IMAGE, IMAGE_EQ_EMPTY] THEN
    ASM_SIMP_TAC std_ss [GSPECIFICATION] THEN
    SIMP_TAC std_ss [EXTENSION, NOT_IN_EMPTY, GSPECIFICATION, NOT_FORALL_THM] THEN
    MESON_TAC[LESS_EQ_REFL],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)] THEN
  MP_TAC(ISPECL
   [``\k:num x:real. sup {(f j x) | k <= j}``,
    ``g:real->real``,
    ``s:real->bool``] MONOTONE_CONVERGENCE_DECREASING) THEN
  ASM_SIMP_TAC std_ss [] THEN
  KNOW_TAC ``(!(k :num) (x :real).
    x IN (s :real -> bool) ==>
    sup {(f :num -> real -> real) j x | SUC k <= j} <=
    sup {f j x | k <= j}) /\
    (!(x :real). x IN s ==>
    (((\(k :num). sup {f j x | k <= j}) --> (g :real -> real) x)
       sequentially :bool)) /\
    (bounded {integral s (\(x :real). sup {f j x | k <= j}) |
     k IN univ((:num) :num itself)} :bool)`` THENL
   [ONCE_REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN] ``{(f:num->real->real) j x | m <= j} =
                                    IMAGE (\j. f j x) {j | m <= j}``] THEN CONJ_TAC THENL
     [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN
      SIMP_TAC real_ss [IMAGE_EQ_EMPTY, SET_RULE ``{x | x IN s} = s``] THEN
      SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, NOT_IN_EMPTY, NOT_LESS_EQUAL] THEN
      CONJ_TAC THENL [EXISTS_TAC ``k + 1:num`` THEN
      ASM_SIMP_TAC arith_ss [], ALL_TAC] THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC IMAGE_SUBSET THEN
        SIMP_TAC std_ss [SUBSET_DEF, IN_NUMSEG, GSPECIFICATION] THEN ARITH_TAC,
        ALL_TAC] THEN
      SIMP_TAC std_ss [FORALL_IN_IMAGE, GSPECIFICATION] THEN
      EXISTS_TAC ``(h(x:real)):real`` THEN REPEAT STRIP_TAC THEN
      MATCH_MP_TAC(REAL_ARITH ``abs(x) <= a ==> x <= a:real``) THEN
      ASM_SIMP_TAC std_ss [],
      ALL_TAC] THEN
    CONJ_TAC THENL
     [X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN ASM_SIMP_TAC std_ss [] THEN
      SIMP_TAC std_ss [LIM_SEQUENTIALLY] THEN
      DISCH_THEN(fn th => X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
                 MP_TAC(SPEC ``e / &2:real`` th)) THEN
      ASM_REWRITE_TAC[REAL_HALF] THEN
      DISCH_THEN (X_CHOOSE_TAC ``M:num``) THEN EXISTS_TAC ``M:num`` THEN
      POP_ASSUM MP_TAC THEN REWRITE_TAC[dist] THEN
      STRIP_TAC THEN X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN
      GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF] THEN
      MATCH_MP_TAC(REAL_ARITH
       ``&0 < e / 2 /\ x <= e / &2 ==> x < e / 2 + e / 2:real``) THEN
      ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC REAL_SUP_ASCLOSE THEN
      SIMP_TAC std_ss [IMAGE_EQ_EMPTY, FORALL_IN_IMAGE, GSPECIFICATION] THEN
      CONJ_TAC THENL [ALL_TAC, METIS_TAC[LESS_EQ_TRANS, REAL_LT_IMP_LE]] THEN
      SIMP_TAC std_ss [EXTENSION, NOT_IN_EMPTY, GSPECIFICATION, NOT_FORALL_THM] THEN
      MESON_TAC[LESS_EQ_REFL],
      ALL_TAC] THEN
    ONCE_REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN]
     ``{integral s (\x. sup (IMAGE (\j. (f:num->real->real) j x)
                                        {j | k <= j})) | k IN t} =
        IMAGE (\k. integral s (\x. sup (IMAGE (\j. (f:num->real->real) j x)
                                    {j | k <= j}))) {k | k IN t}``] THEN
    SIMP_TAC std_ss [bounded_def, FORALL_IN_IMAGE, GSPECIFICATION, IN_UNIV] THEN
    EXISTS_TAC ``(integral s (h:real->real))`` THEN
    X_GEN_TAC ``p:num`` THEN MATCH_MP_TAC INTEGRAL_ABS_BOUND_INTEGRAL THEN
    ASM_SIMP_TAC real_ss [GSYM SIMPLE_IMAGE_GEN] THEN X_GEN_TAC ``x:real`` THEN
    DISCH_TAC THEN
    MATCH_MP_TAC REAL_ABS_SUP_LE THEN
    ONCE_REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN] ``{(f:num->real->real) j x | m <= j} =
                                    IMAGE (\j. f j x) {j | m <= j}``] THEN
    SIMP_TAC std_ss [FORALL_IN_IMAGE, IMAGE_EQ_EMPTY] THEN
    ASM_SIMP_TAC std_ss [GSPECIFICATION] THEN
    SIMP_TAC std_ss [EXTENSION, NOT_IN_EMPTY, GSPECIFICATION, NOT_FORALL_THM] THEN
    MESON_TAC[LESS_EQ_REFL],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    DISCH_THEN(ASSUME_TAC)] THEN
  ASM_REWRITE_TAC[LIM_SEQUENTIALLY] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  UNDISCH_TAC ``((\k. integral s (\x. inf {f j x | k <= j})) --> integral s g)
        sequentially`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM (MP_TAC o REWRITE_RULE [LIM_SEQUENTIALLY]) THEN
  DISCH_THEN(MP_TAC o SPECL [``e:real``]) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_TAC ``N1:num``) THEN
  UNDISCH_TAC ``((\k. integral s (\x. sup {f j x | k <= j})) --> integral s g)
        sequentially`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM (MP_TAC o REWRITE_RULE[LIM_SEQUENTIALLY]) THEN
  DISCH_THEN(MP_TAC o SPECL [``e:real``]) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_TAC ``N2:num``) THEN
  EXISTS_TAC ``N1 + N2:num`` THEN X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN
  UNDISCH_TAC ``!n. N1 <= n ==> dist
           ((\k. integral s (\x. inf {(f:num->real->real) j x | k <= j})) n,
            integral s g) < e`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM (MP_TAC o SPEC ``n:num``) THEN ASM_SIMP_TAC arith_ss [] THEN
  UNDISCH_TAC ``!n. N2 <= n ==> dist
           ((\k. integral s (\x. sup {(f:num->real->real) j x | k <= j})) n,
            integral s g) < e`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM (MP_TAC o SPEC ``n:num``) THEN ASM_SIMP_TAC arith_ss [] THEN
  REWRITE_TAC[dist] THEN
  MATCH_MP_TAC(REAL_ARITH
   ``i0 <= i /\ i <= i1
    ==> abs(i1 - g) < e ==> abs(i0 - g) < e ==> abs(i - g) < e:real``) THEN
  CONJ_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN
  ASM_SIMP_TAC std_ss [] THEN X_GEN_TAC ``x:real`` THEN DISCH_TAC THENL
   [W(MP_TAC o C SPEC INF o rand o lhand o snd) THEN
    SIMP_TAC std_ss [] THEN
    ONCE_REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN] ``{(f:num->real->real) j x | m <= j} =
                                    IMAGE (\j. f j x) {j | m <= j}``] THEN
    SIMP_TAC std_ss [IMAGE_EQ_EMPTY, FORALL_IN_IMAGE, GSPECIFICATION] THEN
    KNOW_TAC ``{j | (n :num) <= j} <> ({} :num -> bool) /\ (?(b :real).
    !(j :num). n <= j ==> b <= (f :num -> real -> real) j (x :real))`` THENL
     [SIMP_TAC std_ss [EXTENSION, NOT_IN_EMPTY, GSPECIFICATION, NOT_FORALL_THM] THEN
      CONJ_TAC THENL [MESON_TAC[LESS_EQ_REFL], ALL_TAC] THEN
      EXISTS_TAC ``-(h(x:real)):real`` THEN GEN_TAC THEN DISCH_TAC THEN
      MATCH_MP_TAC(REAL_ARITH ``abs(x) <= a ==> -a <= x:real``) THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
      DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN REWRITE_TAC[LESS_EQ_REFL]],
    W(MP_TAC o C SPEC SUP o rand o rand o snd) THEN
    SIMP_TAC std_ss [] THEN
    ONCE_REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN] ``{(f:num->real->real) j x | m <= j} =
                                    IMAGE (\j. f j x) {j | m <= j}``] THEN
    SIMP_TAC std_ss [IMAGE_EQ_EMPTY, FORALL_IN_IMAGE, GSPECIFICATION] THEN
    KNOW_TAC ``{j | (n :num) <= j} <> ({} :num -> bool) /\ (?(b :real).
    !(j :num). n <= j ==> (f :num -> real -> real) j (x :real) <= b)`` THENL
     [SIMP_TAC std_ss [EXTENSION, NOT_IN_EMPTY, GSPECIFICATION, NOT_FORALL_THM] THEN
      CONJ_TAC THENL [MESON_TAC[LESS_EQ_REFL], ALL_TAC] THEN
      EXISTS_TAC ``(h(x:real)):real`` THEN GEN_TAC THEN DISCH_TAC THEN
      MATCH_MP_TAC(REAL_ARITH ``abs(x) <= a ==> x <= a:real``) THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
      DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN REWRITE_TAC[LESS_EQ_REFL]]]);

val lemma = prove (
   ``!f:num->real->real g h s.
          (!k. f k absolutely_integrable_on s) /\
          h integrable_on s /\
          (!x. x IN s ==> abs(g x) <= (h x)) /\
          (!x. x IN s ==> ((\k. f k x) --> g x) sequentially)
          ==> g integrable_on s``,
    REPEAT STRIP_TAC THEN
    SUBGOAL_THEN ``(h:real->real) absolutely_integrable_on s``
    ASSUME_TAC THENL
     [MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN
      ASM_SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
      REWRITE_TAC[AND_IMP_INTRO] THEN
      METIS_TAC[REAL_LE_TRANS, ABS_POS],
      ALL_TAC] THEN
    MP_TAC(ISPECL
     [``\n:num x:real.
         (min (max (-((h x):real)) ((f n x))) ((h x)))``,
      ``g:real->real``,
      ``h:real->real``,
      ``s:real->bool``] DOMINATED_CONVERGENCE) THEN
    KNOW_TAC ``(!(k :num).
    (\(n :num) (x :real).
       min (max (-(h :real -> real) x) ((f :num -> real -> real) n x))
         (h x)) k integrable_on (s :real -> bool)) /\ h integrable_on s /\
    (!(k :num) (x :real). x IN s ==>
     abs ((\(n :num) (x :real). min (max (-h x) (f n x)) (h x)) k x) <=
     h x) /\ (!(x :real). x IN s ==>
     (((\(k :num). (\(n :num) (x :real). min (max (-h x) (f n x)) (h x)) k x) -->
      (g :real -> real) x) sequentially :bool))`` THENL
    [ASM_SIMP_TAC std_ss [], SIMP_TAC std_ss []] THEN REPEAT CONJ_TAC THENL
    [ (* goal 1 (of 3) *)
      X_GEN_TAC ``n:num`` THEN
      MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
      ONCE_REWRITE_TAC [METIS [] ``(\x. min (max (-h x) (f n x)) (h x):real) =
                                   (\x. min ((\x. max (-h x) (f n x)) x) (h x))``] THEN
      MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MIN THEN
      ASM_SIMP_TAC std_ss [ETA_AX] THEN
      ONCE_REWRITE_TAC [METIS [] ``(\x. max (-h x) ((f:num->real->real) n x)) =
                                   (\x. max ((\x. (-h x)) x) ((\x. (f n x)) x))``] THEN
      MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX THEN
      METIS_TAC [ETA_AX, ABSOLUTELY_INTEGRABLE_NEG],
      (* goal 2 (of 3) *)
      MAP_EVERY X_GEN_TAC [``n:num``, ``x:real``] THEN DISCH_TAC THEN
      SIMP_TAC std_ss [] THEN
      Know `&0 <= ((h:real->real) x)`
      >- METIS_TAC[REAL_LE_TRANS, ABS_POS] \\
      RW_TAC real_ss [min_def, max_def] >> fs []
      >- (Cases_on `0 <= f n x` >> rw [abs] \\
          Q.PAT_X_ASSUM `-h x <= f n x` MP_TAC >> REAL_ARITH_TAC)
      >> rw [abs],
      (* goal 3 (of 3) *)
      X_GEN_TAC ``x:real`` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
      UNDISCH_TAC
       ``!x. x IN s ==> ((\n. (f:num->real->real) n x) --> g x)
                          sequentially`` THEN
      DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
      REWRITE_TAC[tendsto] THEN DISCH_TAC THEN GEN_TAC THEN
      POP_ASSUM (MP_TAC o SPEC ``e:real``) THEN ASM_CASES_TAC ``&0 < e:real`` THEN
      ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
      X_GEN_TAC ``n:num`` THEN SIMP_TAC std_ss [] THEN
      FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN
      ASM_REWRITE_TAC[dist] THEN KILL_TAC THEN
      REWRITE_TAC [min_def, max_def] THEN
      RW_TAC real_ss [] (* 2 subgoals *)
      >- ASM_REAL_ARITH_TAC \\
      Cases_on `-h x <= f n x` >> fs [] \\
      ASM_REAL_ARITH_TAC ]);

val DOMINATED_CONVERGENCE_INTEGRABLE = store_thm ("DOMINATED_CONVERGENCE_INTEGRABLE",
 ``!f:num->real->real g h s.
         (!k. f k absolutely_integrable_on s) /\
         h integrable_on s /\
         (!k x. x IN s ==> abs(g x) <= (h x)) /\
         (!x. x IN s ==> ((\k. f k x) --> g x) sequentially)
         ==> g integrable_on s``,
  REWRITE_TAC [lemma] );

val DOMINATED_CONVERGENCE_ABSOLUTELY_INTEGRABLE = store_thm ("DOMINATED_CONVERGENCE_ABSOLUTELY_INTEGRABLE",
 ``!f:num->real->real g h s.
         (!k. f k absolutely_integrable_on s) /\
         h integrable_on s /\
         (!k x. x IN s ==> abs(g x) <= (h x)) /\
         (!x. x IN s ==> ((\k. f k x) --> g x) sequentially)
         ==> g absolutely_integrable_on s``,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN
  EXISTS_TAC ``h:real->real`` THEN ASM_SIMP_TAC std_ss [] THEN
  MATCH_MP_TAC DOMINATED_CONVERGENCE_INTEGRABLE THEN
  EXISTS_TAC ``f:num->real->real`` THEN
  EXISTS_TAC ``h:real->real`` THEN ASM_REWRITE_TAC[]);

val DOMINATED_CONVERGENCE_AE = store_thm ("DOMINATED_CONVERGENCE_AE",
 ``!f:num->real->real g h s t.
        (!k. (f k) integrable_on s) /\ h integrable_on s /\ negligible t /\
        (!k x. x IN s DIFF t ==> abs(f k x) <= (h x)) /\
        (!x. x IN s DIFF t ==> ((\k. f k x) --> g x) sequentially)
        ==> g integrable_on s /\
            ((\k. integral s (f k)) --> integral s g) sequentially``,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MP_TAC(ISPECL [``f:num->real->real``, ``g:real->real``,
                 ``h:real->real``, ``s DIFF t:real->bool``]
        DOMINATED_CONVERGENCE) THEN
  ASM_SIMP_TAC std_ss [] THEN
  KNOW_TAC ``(!(k :num).
    (f :num -> real -> real) k integrable_on
    (s :real -> bool) DIFF (t :real -> bool)) /\
 (h :real -> real) integrable_on s DIFF t`` THENL
   [REPEAT STRIP_TAC THEN
    MATCH_MP_TAC(REWRITE_RULE[AND_IMP_INTRO] INTEGRABLE_SPIKE_SET) THEN
    EXISTS_TAC ``s:real->bool`` THEN ASM_SIMP_TAC std_ss [],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
     [MATCH_MP_TAC INTEGRABLE_SPIKE_SET,
      MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN BINOP_TAC THEN
      TRY ABS_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE_SET]] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
    NEGLIGIBLE_SUBSET)) THEN
  SET_TAC[]);

(* ------------------------------------------------------------------------- *)
(* A few more properties of negligible sets.                                 *)
(* ------------------------------------------------------------------------- *)

val NEGLIGIBLE_ON_UNIV = store_thm ("NEGLIGIBLE_ON_UNIV",
 ``!s. negligible s <=> (indicator s has_integral 0) univ(:real)``,
  GEN_TAC THEN EQ_TAC THENL [SIMP_TAC std_ss [NEGLIGIBLE], ALL_TAC] THEN
  DISCH_TAC THEN REWRITE_TAC[negligible] THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN
  SUBGOAL_THEN ``indicator s integrable_on interval[a:real,b]``
  ASSUME_TAC THENL
   [MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN
    EXISTS_TAC ``univ(:real)`` THEN ASM_MESON_TAC[SUBSET_UNIV, integrable_on],
    ASM_SIMP_TAC std_ss [GSYM INTEGRAL_EQ_HAS_INTEGRAL] THEN
    REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
    CONJ_TAC THENL
     [FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP INTEGRAL_UNIQUE) THEN
      MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE,
      MATCH_MP_TAC INTEGRAL_DROP_POS] THEN
    ASM_REWRITE_TAC[SUBSET_UNIV, DROP_INDICATOR_POS_LE] THEN
    ASM_MESON_TAC[integrable_on]]);

val NEGLIGIBLE_COUNTABLE_BIGUNION = store_thm ("NEGLIGIBLE_COUNTABLE_BIGUNION",
 ``!s:num->real->bool.
        (!n. negligible(s n)) ==> negligible(BIGUNION {s(n) | n IN univ(:num)})``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [``\n. indicator(BIGUNION {(s:num->real->bool)(m) | m <= n})``,
             ``indicator(BIGUNION {(s:num->real->bool)(m) | m IN univ(:num)})``,
                 ``univ(:real)``] MONOTONE_CONVERGENCE_INCREASING) THEN
  SUBGOAL_THEN
   ``!n. negligible(BIGUNION {(s:num->real->bool)(m) | m <= n})``
  ASSUME_TAC THENL
   [GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_BIGUNION THEN
    ONCE_REWRITE_TAC [METIS [] ``!n:num. m <= n <=> (\m. m <= n) m``] THEN
    ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
    ASM_SIMP_TAC std_ss [IMAGE_FINITE, FINITE_NUMSEG_LE, FORALL_IN_IMAGE],
    ALL_TAC] THEN
  SUBGOAL_THEN
   ``!n:num. (indicator (BIGUNION {s m | m <= n})) integrable_on univ(:real)``
  ASSUME_TAC THENL
   [METIS_TAC[NEGLIGIBLE_ON_UNIV, integrable_on], ALL_TAC] THEN
  SUBGOAL_THEN
   ``!n:num. integral univ(:real) (indicator (BIGUNION {s m | m <= n})) = 0``
  ASSUME_TAC THENL
   [METIS_TAC[NEGLIGIBLE_ON_UNIV, INTEGRAL_UNIQUE], ALL_TAC] THEN
  ASM_SIMP_TAC std_ss [NEGLIGIBLE_ON_UNIV, LIM_CONST_EQ,
               TRIVIAL_LIMIT_SEQUENTIALLY] THEN
  KNOW_TAC ``(!(k :num) (x :real).
        x IN univ((:real) :real itself) ==>
        indicator (BIGUNION {(s :num -> real -> bool) m | m <= k}) x <=
        indicator (BIGUNION {s m | m <= SUC k}) x) /\
     (!(x :real).
        x IN univ((:real) :real itself) ==>
        (((\(k :num). indicator (BIGUNION {s m | m <= k}) x) -->
          indicator (BIGUNION {s m | m IN univ((:num) :num itself)}) x)
           sequentially :bool)) /\
     (bounded {(0 :real) | k IN univ((:num) :num itself)} :bool)`` THENL
  [ALL_TAC, DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
   METIS_TAC[INTEGRAL_EQ_HAS_INTEGRAL]] THEN
  REPEAT CONJ_TAC THENL
   [MAP_EVERY X_GEN_TAC [``k:num``, ``x:real``] THEN DISCH_TAC THEN
    REWRITE_TAC[indicator] THEN
    SUBGOAL_THEN
     ``x IN BIGUNION {(s:num->real->bool) m | m <= k}
      ==> x IN BIGUNION {s m | m <= SUC k}``
    MP_TAC THENL
     [SPEC_TAC(``x:real``,``x:real``) THEN
      REWRITE_TAC[GSYM SUBSET_DEF] THEN MATCH_MP_TAC SUBSET_BIGUNION THEN
      ONCE_REWRITE_TAC [METIS [] ``!n:num. m <= n <=> (\m. m <= n) m``] THEN
      ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
      SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION] THEN ARITH_TAC,
      BETA_TAC THEN
      REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC std_ss []) THEN
      SIMP_TAC std_ss [REAL_LE_REFL, REAL_POS]],
    X_GEN_TAC ``x:real`` THEN DISCH_THEN(K ALL_TAC) THEN
    MATCH_MP_TAC LIM_EVENTUALLY THEN
    REWRITE_TAC[EVENTUALLY_SEQUENTIALLY, indicator] THEN
    ASM_CASES_TAC ``x IN BIGUNION {(s:num->real->bool) m | m IN univ(:num)}`` THENL
     [FIRST_X_ASSUM(MP_TAC o SIMP_RULE std_ss [BIGUNION_GSPEC,
       METIS [] ``!n:num. m <= n <=> (\m. m <= n) m``]) THEN
      SIMP_TAC std_ss [GSPECIFICATION, IN_UNIV] THEN
      STRIP_TAC THEN EXISTS_TAC ``m:num`` THEN
      X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN
      SIMP_TAC std_ss [BIGUNION_GSPEC, GSPECIFICATION] THEN METIS_TAC[],
      EXISTS_TAC ``0:num`` THEN X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN
      ASM_SIMP_TAC std_ss [] THEN
      UNDISCH_TAC `` (x :real) NOTIN
          BIGUNION
            {(s :num -> real -> bool) m | m IN univ((:num) :num itself)}`` THEN
      DISCH_TAC THEN
      POP_ASSUM (MP_TAC o SIMP_RULE std_ss [BIGUNION_GSPEC]) THEN
      SIMP_TAC std_ss [BIGUNION_GSPEC, GSPECIFICATION, IN_UNIV]],
    REWRITE_TAC[SET_RULE ``{c | x | x IN UNIV} = {c}``,
                BOUNDED_INSERT, BOUNDED_EMPTY]]);

val lemma = prove (
   ``!f:real->real s.
          (!x. x IN s ==> &0 <= (f x)) /\ (f has_integral 0) s
          ==> negligible {x | x IN s /\ ~(f x = 0)}``,
    REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC
     ``BIGUNION {{x | x IN s /\ abs((f:real->real) x) >= &1 / (&n + &1:real)} |
              n IN univ(:num)}`` THEN
    CONJ_TAC THENL
     [ONCE_REWRITE_TAC [METIS []
      ``{x | x IN s /\ abs (f x) >= 1 / (&n + 1)} =
        (\n. {x | x IN s /\ abs (f x) >= 1 / (&n + 1)}) n``] THEN
      MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_BIGUNION THEN
      X_GEN_TAC ``n:num`` THEN SIMP_TAC std_ss [NEGLIGIBLE_ON_UNIV, indicator] THEN
      MATCH_MP_TAC HAS_INTEGRAL_STRADDLE_NULL THEN
      EXISTS_TAC ``(\x. if x IN s then (&n + &1) * f(x) else 0):real->real`` THEN
      CONJ_TAC THENL
       [SIMP_TAC std_ss [IN_UNIV, GSPECIFICATION, real_ge] THEN
        X_GEN_TAC ``x:real`` THEN COND_CASES_TAC THEN
        ASM_SIMP_TAC std_ss [REAL_POS] THENL
         [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
          ASM_SIMP_TAC std_ss [GSYM REAL_LE_LDIV_EQ,
           METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0]
                   ``&0 < &n + &1:real``] THEN
          MATCH_MP_TAC(REAL_ARITH ``&0 <= x /\ a <= abs x ==> a <= x:real``) THEN
          ASM_SIMP_TAC std_ss [],
          COND_CASES_TAC THEN REWRITE_TAC[REAL_POS] THEN
          ASM_SIMP_TAC std_ss [REAL_POS, REAL_LE_MUL, REAL_LE_ADD]],
        SIMP_TAC std_ss [HAS_INTEGRAL_RESTRICT_UNIV] THEN
        SUBST1_TAC(REAL_ARITH ``0:real = (&n + &1) * 0``) THEN
        MATCH_MP_TAC HAS_INTEGRAL_CMUL THEN ASM_REWRITE_TAC[]],
      SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION] THEN X_GEN_TAC ``x:real`` THEN
      REWRITE_TAC[ABS_NZ] THEN ONCE_REWRITE_TAC[REAL_ARCH_INV] THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN ``n:num``
        STRIP_ASSUME_TAC)) THEN
      SIMP_TAC std_ss [IN_BIGUNION, EXISTS_IN_GSPEC] THEN
      ASM_SIMP_TAC std_ss [IN_UNIV, GSPECIFICATION, real_ge] THEN
      EXISTS_TAC ``{x' | x' IN (s :real -> bool) /\
         (1 :real) / (((&n) :real) + (1 :real)) <=
         abs ((f :real -> real) x')}`` THEN CONJ_TAC THENL
      [ASM_SIMP_TAC std_ss [GSPECIFICATION, REAL_LE_LT] THEN DISJ1_TAC THEN
       MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ``inv (&n):real`` THEN
       ASM_REWRITE_TAC [GSYM REAL_INV_1OVER] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
       SIMP_TAC std_ss [REAL_LT, REAL_OF_NUM_ADD, REAL_OF_NUM_LE] THEN
       UNDISCH_TAC ``n <> 0:num`` THEN ARITH_TAC,
       EXISTS_TAC ``n:num`` THEN ASM_SIMP_TAC std_ss []]]);

val HAS_INTEGRAL_NEGLIGIBLE_EQ = store_thm ("HAS_INTEGRAL_NEGLIGIBLE_EQ",
 ``!f:real->real s.
        (!x i. x IN s ==> &0 <= f(x))
        ==> ((f has_integral 0) s <=>
             negligible {x | x IN s /\ ~(f x = 0)})``,
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
   [ALL_TAC,
    MATCH_MP_TAC HAS_INTEGRAL_NEGLIGIBLE THEN
    EXISTS_TAC ``{x | x IN s /\ ~((f:real->real) x = 0)}`` THEN
    ASM_SIMP_TAC std_ss [IN_DIFF, GSPECIFICATION] THEN MESON_TAC[]] THEN
  MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
  EXISTS_TAC ``BIGUNION {{x | x IN s /\ ~(((f:real->real) x) = &0)}}`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC NEGLIGIBLE_BIGUNION THEN
    SIMP_TAC real_ss [GSYM IMAGE_DEF, IMAGE_FINITE, FINITE_NUMSEG, FORALL_IN_IMAGE,
     IN_SING, FINITE_SING] THEN MATCH_MP_TAC lemma THEN
    ASM_SIMP_TAC std_ss [],
    SIMP_TAC std_ss [SUBSET_DEF, IN_BIGUNION, EXISTS_IN_GSPEC, IN_NUMSEG] THEN
    SIMP_TAC std_ss [GSPECIFICATION, IN_SING] THEN MESON_TAC[]]);

val lemma = prove (
  ``IMAGE f s = BIGUNION {(\x. {f x}) x | x IN s}``,
    SIMP_TAC std_ss [EXTENSION, IN_IMAGE, IN_BIGUNION, IN_SING, GSPECIFICATION] THEN
    MESON_TAC[IN_SING]);

val NEGLIGIBLE_COUNTABLE = store_thm ("NEGLIGIBLE_COUNTABLE",
 ``!s:real->bool. COUNTABLE s ==> negligible s``,
  GEN_TAC THEN ASM_CASES_TAC ``s:real->bool = {}`` THEN
  ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN
  POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
  DISCH_THEN(X_CHOOSE_THEN ``f:num->real`` SUBST1_TAC o
    MATCH_MP COUNTABLE_AS_IMAGE) THEN
  ONCE_REWRITE_TAC[lemma] THEN
  MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_BIGUNION THEN
  SIMP_TAC std_ss [NEGLIGIBLE_SING]);

(* ------------------------------------------------------------------------- *)
(* More basic "almost everywhere" variants of other theorems.                *)
(* ------------------------------------------------------------------------- *)

val HAS_INTEGRAL_COMPONENT_LE_AE = store_thm ("HAS_INTEGRAL_COMPONENT_LE_AE",
 ``!f:real->real g:real->real s i j k t.
        negligible t /\
        (f has_integral i) s /\ (g has_integral j) s /\
        (!x. x IN s DIFF t ==> (f x) <= (g x))
        ==> i <= j``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LE THEN
  EXISTS_TAC ``\x. if x IN t then 0 else (f:real->real) x`` THEN
  EXISTS_TAC ``\x. if x IN t then 0 else (g:real->real) x`` THEN
  EXISTS_TAC ``s:real->bool`` THEN ASM_REWRITE_TAC[] THEN
  REPEAT STRIP_TAC THENL
   [MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN EXISTS_TAC ``f:real->real`` THEN
    EXISTS_TAC ``t:real->bool`` THEN ASM_SIMP_TAC std_ss [IN_DIFF],
    MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN EXISTS_TAC ``g:real->real`` THEN
    EXISTS_TAC ``t:real->bool`` THEN ASM_SIMP_TAC std_ss [IN_DIFF],
    SIMP_TAC std_ss [] THEN COND_CASES_TAC THEN
    ASM_SIMP_TAC std_ss [IN_DIFF, REAL_LE_REFL]]);

val INTEGRAL_COMPONENT_LE_AE = store_thm ("INTEGRAL_COMPONENT_LE_AE",
 ``!f:real->real g:real->real s k t.
        negligible t /\
        f integrable_on s /\ g integrable_on s /\
        (!x. x IN s DIFF t ==> (f x) <= (g x))
        ==> (integral s f) <= (integral s g)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LE_AE THEN
  ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);

val HAS_INTEGRAL_LE_AE = store_thm ("HAS_INTEGRAL_LE_AE",
 ``!f:real->real g:real->real s i j t.
        (f has_integral i) s /\ (g has_integral j) s /\
        negligible t /\ (!x. x IN s DIFF t ==> (f x) <= (g x))
        ==> i <= j``,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LE_AE THEN
  REWRITE_TAC[LESS_EQ_REFL] THEN ASM_MESON_TAC[]);

val INTEGRAL_LE_AE = store_thm ("INTEGRAL_LE_AE",
 ``!f:real->real g:real->real s t.
        f integrable_on s /\ g integrable_on s /\
        negligible t /\ (!x. x IN s DIFF t ==> (f x) <= (g x))
        ==> (integral s f) <= (integral s g)``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_LE_AE THEN
  ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);

val NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE = store_thm ("NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE",
 ``!f:real->real s t.
        negligible t /\
        (!x i. x IN s DIFF t
               ==> &0 <= f(x)) /\
        f integrable_on s
        ==> f absolutely_integrable_on s``,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[AND_IMP_INTRO] ABSOLUTELY_INTEGRABLE_SPIKE) THEN
  EXISTS_TAC ``\x. if x IN s DIFF t then (f:real->real) x else 0`` THEN
  EXISTS_TAC ``t:real->bool`` THEN ASM_SIMP_TAC std_ss [] THEN
  MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN
  SIMP_TAC std_ss [] THEN CONJ_TAC THENL
   [METIS_TAC[REAL_LE_REFL], ALL_TAC] THEN
  MATCH_MP_TAC(REWRITE_RULE[AND_IMP_INTRO] INTEGRABLE_SPIKE) THEN
  MAP_EVERY EXISTS_TAC [``f:real->real``, ``t:real->bool``] THEN
  ASM_SIMP_TAC std_ss []);

val INTEGRAL_ABS_BOUND_INTEGRAL_AE = store_thm ("INTEGRAL_ABS_BOUND_INTEGRAL_AE",
 ``!f:real->real g s t.
        f integrable_on s /\ g integrable_on s /\
        negligible t /\ (!x. x IN s DIFF t ==> abs(f x) <= (g x))
        ==> abs(integral s f) <= (integral s g)``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL
   [``\x. if x IN s DIFF t then (f:real->real) x else 0``,
    ``\x. if x IN s DIFF t then (g:real->real) x else 0``,
    ``s:real->bool``]
    INTEGRAL_ABS_BOUND_INTEGRAL) THEN
  SIMP_TAC std_ss [] THEN
  KNOW_TAC ``(\(x :real).
    if x IN (s :real -> bool) DIFF (t :real -> bool) then
      (f :real -> real) x
    else (0 :real)) integrable_on s /\
    (\(x :real).
    if x IN s DIFF t then (g :real -> real) x
    else (0 :real)) integrable_on s /\
   (!(x :real). x IN s ==>
    abs (if x IN s DIFF t then f x else (0 :real)) <=
    if x IN s DIFF t then g x else (0 :real))`` THENL
   [REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC(REWRITE_RULE[AND_IMP_INTRO] INTEGRABLE_SPIKE) THEN
      EXISTS_TAC ``f:real->real``,
      MATCH_MP_TAC(REWRITE_RULE[AND_IMP_INTRO] INTEGRABLE_SPIKE) THEN
      EXISTS_TAC ``g:real->real``,
      METIS_TAC[REAL_LE_REFL, ABS_0]] THEN
    EXISTS_TAC ``t:real->bool`` THEN ASM_SIMP_TAC std_ss [],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    MATCH_MP_TAC EQ_IMPLIES THEN BINOP_TAC THENL
    [AP_TERM_TAC, ALL_TAC] THEN
    MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC ``t:real->bool`` THEN
    ASM_SIMP_TAC std_ss []]);

(* ------------------------------------------------------------------------- *)
(* Beppo Levi theorem.                                                       *)
(* ------------------------------------------------------------------------- *)

Theorem BEPPO_LEVI_INCREASING :
    !f:num->real->real s.
        (!k. (f k) integrable_on s) /\
        (!k x. x IN s ==> (f k x) <= (f (SUC k) x)) /\
        bounded {integral s (f k) | k IN univ(:num)}
        ==> ?g k. negligible k /\
                  !x. x IN (s DIFF k) ==> ((\k. f k x) --> g x) sequentially
Proof
  SUBGOAL_THEN
   ``!f:num->real->real s.
        (!k x. x IN s ==> &0 <= (f k x)) /\
        (!k. (f k) integrable_on s) /\
        (!k x. x IN s ==> (f k x) <= (f (SUC k) x)) /\
        bounded {integral s (f k) | k IN univ(:num)}
        ==> ?g k. negligible k /\
                  !x. x IN (s DIFF k) ==> ((\k. f k x) --> g x) sequentially``
  ASSUME_TAC THENL
  [ ALL_TAC,
    REPEAT GEN_TAC THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o ISPECL
     [``\n x:real. f(n:num) x - (f 0 x):real``, ``s:real->bool``]) THEN
    SIMP_TAC std_ss [] THEN
    KNOW_TAC ``(!(k :num) (x :real).
    x IN (s :real -> bool) ==>
    (0 :real) <= (f :num -> real -> real) k x - f (0 :num) x) /\
     (!(k :num). (\(x :real). f k x - f (0 :num) x) integrable_on s) /\
     (!(k :num) (x :real). x IN s ==>
    (f k x - f (0 :num) x) <=
    f (SUC k) x - f (0 :num) x) /\
     (bounded {integral s (\(x :real). f k x - f (0 :num) x) |
     k IN univ((:num) :num itself)} :bool)`` THEN
     REPEAT CONJ_TAC THENL (* 5 goals *)
     [(* goal 1 (of 5) *)
      REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_SUB_LE] THEN
      MP_TAC(ISPEC
        ``\m n:num. (f m (x:real)) <= (f n x):real``
        TRANSITIVE_STEPWISE_LE) THEN SIMP_TAC real_ss [REAL_LE_REFL] THEN
      KNOW_TAC ``(!(x' :num) (y :num) (z :num).
       (f :num -> real -> real) x' (x :real) <= f y x /\ f y x <= f z x ==>
        f x' x <= f z x) `` THENL
      [REPEAT GEN_TAC THEN STRIP_TAC THEN METIS_TAC [REAL_LE_TRANS],
       DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
      ASM_MESON_TAC[LE_0],
      (* goal 2 (of 5) *)
      GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_SUB THEN METIS_TAC[ETA_AX],
      (* goal 3 (of 5) *)
      REPEAT STRIP_TAC THEN
      ASM_SIMP_TAC std_ss [REAL_ARITH ``x - a <= y - a <=> x <= y:real``],
      (* goal 4 (of 5) *)
      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [bounded_def]) THEN
      KNOW_TAC ``!k. (\x. (f:num->real->real) k x) integrable_on s`` THENL
      [METIS_TAC [ETA_AX], DISCH_TAC] THEN
      ASM_SIMP_TAC std_ss  [INTEGRAL_SUB, bounded_def] THEN
      SIMP_TAC real_ss [GSYM IMAGE_DEF] THEN
      SIMP_TAC std_ss [FORALL_IN_IMAGE, IN_UNIV] THEN
      DISCH_THEN(X_CHOOSE_THEN ``B:real``
        (fn th => EXISTS_TAC ``B + abs(integral s (f (0:num):real->real))`` THEN
                   X_GEN_TAC ``k:num`` THEN MP_TAC(SPEC ``k:num`` th))) THEN
      REWRITE_TAC [METIS [ETA_AX] ``(\x. f k x) = f k``] THEN
      REAL_ARITH_TAC,
      (* goal 5 (of 5) *)
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
      KNOW_TAC ``(?(k :real -> bool) (g :real -> real).
        negligible k /\ !(x :real). x IN (s :real -> bool) DIFF k ==>
        (((\(k :num). (f :num -> real -> real) k x - f (0 :num) x) --> g x)
        sequentially :bool)) ==>
                  ?(k :real -> bool) (g :real -> real).
        negligible k /\ !(x :real).
        x IN s DIFF k ==> (((\(k :num). f k x) --> g x) sequentially :bool)`` THENL
      [ALL_TAC, METIS_TAC [SWAP_EXISTS_THM]] THEN
      DISCH_THEN (X_CHOOSE_TAC ``k:real->bool``) THEN EXISTS_TAC ``k:real->bool`` THEN
      POP_ASSUM MP_TAC THEN
      DISCH_THEN(X_CHOOSE_THEN ``g:real->real`` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC ``(\x. g x + f (0:num) x):real->real`` THEN
      ASM_SIMP_TAC std_ss [] THEN X_GEN_TAC ``x:real`` THEN
      DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN
      ASM_SIMP_TAC std_ss [LIM_SEQUENTIALLY, dist] THEN
      REWRITE_TAC[REAL_ARITH ``a - b - c:real = a - (c + b)``] ] ] THEN
  REPEAT STRIP_TAC THEN
  ABBREV_TAC
   ``g = \i n:num x:real. min (((f:num->real->real) n x) / (&i + &1)) (&1)`` THEN
  SUBGOAL_THEN
   ``!i n. ((g:num->num->real->real) i n) integrable_on s``
  ASSUME_TAC THENL
   [REPEAT GEN_TAC THEN EXPAND_TAC "g" THEN
     ONCE_REWRITE_TAC [METIS [] ``(\x. min ((f:num->real->real) n x / (&i + 1)) 1) =
                          (\x. min ((\x. (f n x / (&i + 1))) x) 1)``] THEN
    MATCH_MP_TAC INTEGRABLE_MIN_CONST THEN
    ASM_SIMP_TAC std_ss [REAL_POS, REAL_LE_DIV, REAL_LE_ADD] THEN
    REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN
    METIS_TAC [INTEGRABLE_CMUL, ETA_AX],
    ALL_TAC] THEN
  SUBGOAL_THEN
   ``!i:num k:num x:real. x IN s ==> (g i k x):real <= (g i (SUC k) x)``
  ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN EXPAND_TAC "g" THEN
    KNOW_TAC ``!x y a:real. x <= y ==> min x a <= min y a`` THENL
    [RW_TAC real_ss [min_def] THEN
     `a < x'` by PROVE_TAC [real_lte] \\
     `a < y` by PROVE_TAC [REAL_LTE_TRANS] \\
     PROVE_TAC [REAL_LTE_ANTISYM], DISCH_TAC] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC [real_div] THEN
    MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC real_ss [REAL_POS, REAL_LE_REFL] THEN
     MATCH_MP_TAC REAL_LE_INV THEN
    ASM_SIMP_TAC std_ss [REAL_LE_LT, GSYM REAL_OF_NUM_ADD,
      METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0]  ``&0 < &n + &1:real``],
    ALL_TAC] THEN
  SUBGOAL_THEN ``!i:num k:num x:real. x IN s ==> abs(g i k x:real) <= &1:real``
  ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN EXPAND_TAC "g" THEN
    KNOW_TAC ``0 <= ((f :num -> real -> real) (k :num) (x :real) /
      (((&(i :num)) :real) + (1 :real)))`` THENL
    [REWRITE_TAC [real_div] THEN MATCH_MP_TAC REAL_LE_MUL THEN
     ASM_SIMP_TAC real_ss [] THEN MATCH_MP_TAC REAL_LE_INV THEN
     ASM_SIMP_TAC std_ss [REAL_LE_LT, GSYM REAL_OF_NUM_ADD,
     METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0]  ``&0 < &n + &1:real``],
      ALL_TAC] THEN REWRITE_TAC [min_def] THEN
      Cases_on `f k x / (&i + 1) <= 1` >> fs [abs],
     ALL_TAC] THEN
  SUBGOAL_THEN
   ``!i:num x:real. x IN s ==> ?h:real. ((\n. (g i n x):real) --> h) sequentially``
  MP_TAC THENL (* subgoals *)
  [ (* goal 1 (of 2) *)
    REPEAT STRIP_TAC THEN
    MP_TAC(ISPECL
     [``\n. (g (i:num) (n:num) (x:real)):real``, ``&1:real``]
     CONVERGENT_BOUNDED_MONOTONE) THEN
    SIMP_TAC std_ss [] THEN
    KNOW_TAC ``(!(n :num).
    abs ((g :num -> num -> real -> real) (i :num) n (x :real)) <= (1:real)) /\
    ((!(m :num) (n :num). m <= n ==> g i m x <= g i n x) \/
    !(m :num) (n :num). m <= n ==> g i n x <= g i m x)`` THENL
     [ASM_SIMP_TAC std_ss [] THEN DISJ1_TAC THEN
      ONCE_REWRITE_TAC [METIS [] ``g i m x <= (g:num->num->real->real) i n x <=>
                        (\m n:num. g i m x <= g i n x) m n``] THEN
      MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
      METIS_TAC [REAL_LE_REFL, REAL_LE_TRANS],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
      DISCH_THEN(X_CHOOSE_THEN ``l:real`` (fn th =>
        EXISTS_TAC ``l:real`` THEN MP_TAC th)) THEN
      SIMP_TAC std_ss [LIM_SEQUENTIALLY, dist]],
    (* goal 2 (of 2) *)
    DISCH_THEN (MP_TAC o SIMP_RULE std_ss [RIGHT_IMP_EXISTS_THM]) THEN
    SIMP_TAC std_ss [SKOLEM_THM, LEFT_IMP_EXISTS_THM] ] THEN
  X_GEN_TAC ``h:num->real->real`` THEN STRIP_TAC THEN
  MP_TAC(GEN ``i:num`` (ISPECL
   [``g(i:num):num->real->real``, ``h(i:num):real->real``,
    ``s:real->bool``] MONOTONE_CONVERGENCE_INCREASING)) THEN
  DISCH_TAC THEN
  KNOW_TAC ``(!(i :num).
   (!(k :num).
      (g :num -> num -> real -> real) i k integrable_on
      (s :real -> bool)) /\
   (!(k :num) (x :real). x IN s ==> g i k x <= g i (SUC k) x) /\
   (!(x :real).
      x IN s ==>
      (((\(k :num). g i k x) --> (h :num -> real -> real) i x)
         sequentially :bool)) /\
   (bounded {integral s (g i k) | k IN univ((:num) :num itself)} :
      bool)) ==> (!(i :num).
   h i integrable_on s /\
   (((\(k :num). integral s (g i k)) --> integral s (h i))
      sequentially :bool))`` THENL
   [METIS_TAC [MONO_ALL], POP_ASSUM K_TAC] THEN
  ASM_SIMP_TAC std_ss [] THEN
  (* stage work *)
  KNOW_TAC ``(!(i :num).
    (bounded
       {integral (s :real -> bool)
          ((g :num -> num -> real -> real) i k) |
        k IN univ((:num) :num itself)} :bool))`` THENL
  [ (* goal 1 (of 2):
       !i. bounded {integral s (g i k) | k IN univ(:num)} *)
    GEN_TAC THEN REWRITE_TAC[bounded_def] THEN
    UNDISCH_TAC ``bounded {integral s (f k) | k IN univ(:num)}`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [bounded_def]) THEN
    DISCH_THEN (X_CHOOSE_TAC ``kk:real``) THEN EXISTS_TAC ``kk:real`` THEN
    POP_ASSUM MP_TAC THEN
    SIMP_TAC std_ss [FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_UNIV] THEN
    DISCH_TAC THEN X_GEN_TAC ``k:num`` THEN POP_ASSUM (MP_TAC o SPEC ``k:num``) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
    MATCH_MP_TAC(REAL_ARITH
     ``(abs a = a) /\ x <= a ==> x <= a:real``) THEN
    CONJ_TAC THENL
    [ (* goal 1.1 (of 2) *)
      SIMP_TAC std_ss [ABS_ABS],
      (* goal 1.2 (of 2) *)
      GEN_REWR_TAC RAND_CONV [abs] THEN
      ASM_SIMP_TAC real_ss [INTEGRAL_DROP_POS] THEN
      MATCH_MP_TAC INTEGRAL_ABS_BOUND_INTEGRAL THEN
      ASM_SIMP_TAC std_ss [] THEN X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
      EXPAND_TAC "g" THEN
      KNOW_TAC ``0 <= ((f :num -> real -> real) (k :num) (x :real) /
                      (((&(i :num)) :real) + (1 :real))) /\
                      ((f :num -> real -> real) (k :num) (x :real) /
                      (((&(i :num)) :real) + (1 :real))) <= f k x`` THENL
      [ (* goal 1.2.1 (of 2):
           0 <= f k x / (&i + 1) /\ f k x / (&i + 1) <= f k x *)
        CONJ_TAC THENL
        [ (* goal 1.2.1.1 (of 2) *)
          REWRITE_TAC [real_div] THEN MATCH_MP_TAC REAL_LE_MUL THEN
          ASM_SIMP_TAC real_ss [] THEN MATCH_MP_TAC REAL_LE_INV THEN
          ASM_SIMP_TAC std_ss [REAL_LE_LT, GSYM REAL_OF_NUM_ADD,
             METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0]  ``&0 < &n + &1:real``],
          (* goal 1.2.1.2 (of 2) *)
          ALL_TAC ] THEN
        SIMP_TAC real_ss [REAL_LE_LDIV_EQ] THEN
        GEN_REWR_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN
        ONCE_REWRITE_TAC [GSYM REAL_SUB_LE] THEN REWRITE_TAC [GSYM REAL_SUB_LDISTRIB] THEN
        MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC real_ss [] THEN
        ASM_SIMP_TAC std_ss [REAL_LE_LT, GSYM REAL_OF_NUM_ADD,
           METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0]  ``&0 < &n + &1:real``] THEN
        REWRITE_TAC [REAL_ADD_SUB_ALT, GSYM REAL_LE_LT, REAL_POS],
        (* goal 1.2.2 (of 2) *)
        ALL_TAC] THEN
      RW_TAC std_ss [min_def]
      >- (NTAC 3 (POP_ASSUM MP_TAC) >> REAL_ARITH_TAC) \\
      rw [abs] >> NTAC 3 (POP_ASSUM MP_TAC) \\
      REAL_ARITH_TAC ],
    (* goal 2 (of 2) *)
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    SIMP_TAC std_ss [FORALL_AND_THM] THEN STRIP_TAC ] THEN
  ABBREV_TAC
   ``Z =
    {x:real | x IN s /\ ~(?l:real. ((\k. f k x) --> l) sequentially)}`` THEN
  KNOW_TAC ``?(k :real ->bool) (g :real -> real).
  negligible k /\
  !(x :real).
    x IN (s :real -> bool) DIFF k ==>
    (((\(k :num). (f :num -> real -> real) k x) --> g x) sequentially :
       bool)`` THENL [ALL_TAC, METIS_TAC [SWAP_EXISTS_THM]] THEN
  EXISTS_TAC ``Z:real->bool`` THEN
  SIMP_TAC std_ss [RIGHT_EXISTS_AND_THM, GSYM SKOLEM_THM, RIGHT_EXISTS_IMP_THM] THEN
  CONJ_TAC THENL
   [ALL_TAC, EXPAND_TAC "Z" THEN SIMP_TAC std_ss [GSPECIFICATION] THEN SET_TAC[]] THEN
  MP_TAC(ISPECL
   [``h:num->real->real``,
    ``(\x. if x IN Z then 1 else 0):real->real``,
    ``s:real->bool``]
        MONOTONE_CONVERGENCE_DECREASING) THEN
  ASM_SIMP_TAC std_ss [] THEN
  SUBGOAL_THEN
   ``!i x:real. x IN s ==> (h (SUC i) x) <= (h i x):real``
  ASSUME_TAC THENL
  [ (* goal 1 (of 2) *)
    MAP_EVERY X_GEN_TAC [``i:num``, ``x:real``] THEN DISCH_TAC THEN
    MATCH_MP_TAC(ISPEC ``sequentially`` LIM_DROP_LE) THEN
    EXISTS_TAC ``\n. (g:num->num->real->real) (SUC i) n x`` THEN
    EXISTS_TAC ``\n. (g:num->num->real->real) i n x`` THEN
    ASM_SIMP_TAC std_ss [TRIVIAL_LIMIT_SEQUENTIALLY] THEN
    MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC ``n:num`` THEN
    EXPAND_TAC "g" THEN SIMP_TAC std_ss [] THEN
    KNOW_TAC ``!x y a:real. x <= y ==> min x a <= min y a`` THENL
    [ KILL_TAC \\
      RW_TAC real_ss [min_def] \\
      `a < x` by PROVE_TAC [real_lte] \\
      `a < y` by PROVE_TAC [REAL_LTE_TRANS] \\
      PROVE_TAC [REAL_LTE_ANTISYM], DISCH_TAC] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL_IMP THEN
    ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
    REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN SIMP_TAC real_ss [REAL_POS],
    (* goal 2 (of 2) *)
    ASM_SIMP_TAC std_ss [] ] THEN
  UNDISCH_TAC ``bounded {integral s (f k) | k IN univ(:num)}`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [BOUNDED_POS]) THEN
  SIMP_TAC std_ss [FORALL_IN_GSPEC, IN_UNIV] THEN
  DISCH_THEN(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   ``!i. abs(integral s ((h:num->real->real) i)) <= B / (&i + &1)``
  ASSUME_TAC THENL
  [ (* goal 1 (of 2) *)
    X_GEN_TAC ``i:num`` THEN
    MATCH_MP_TAC(ISPEC ``sequentially`` LIM_ABS_UBOUND) THEN
    EXISTS_TAC ``\k. integral s ((g:num->num->real->real) i k)`` THEN
    ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN
    MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC ``n:num`` THEN
    SIMP_TAC std_ss [] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC
     ``(integral s (\x. inv(&i + &1) * (f:num->real->real) n x))`` THEN
    CONJ_TAC THENL
    [ (* goal 1.1 (of 2) *)
      MATCH_MP_TAC INTEGRAL_ABS_BOUND_INTEGRAL THEN ASM_SIMP_TAC std_ss [] THEN
      CONJ_TAC THENL [METIS_TAC [INTEGRABLE_CMUL, ETA_AX], ALL_TAC] THEN
      X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN EXPAND_TAC "g" THEN
      KNOW_TAC ``0 <= ((f :num -> real -> real) (n :num) (x :real) /
                      (((&(i :num)) :real) + (1 :real))) /\
                      ((f :num -> real -> real) (n :num) (x :real) /
                      (((&(i :num)) :real) + (1 :real))) <= inv (&i + 1) * f n x`` THENL
      [ (* goal 1.1.1 (of 2) *)
        CONJ_TAC THENL
        [ (* goal 1.1.1.1 (of 2) *)
          REWRITE_TAC [real_div] THEN MATCH_MP_TAC REAL_LE_MUL THEN
          ASM_SIMP_TAC real_ss [] THEN MATCH_MP_TAC REAL_LE_INV THEN
          ASM_SIMP_TAC std_ss [REAL_LE_LT, GSYM REAL_OF_NUM_ADD,
             METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0] ``&0 < &n + &1:real``],
          (* goal 1.1.1.2 (of 2) *)
          ALL_TAC ] THEN
        SIMP_TAC real_ss [REAL_LE_LDIV_EQ] THEN
        GEN_REWR_TAC RAND_CONV [REAL_ARITH ``a * b * c = b * (a * c:real)``] THEN
        GEN_REWR_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN
        ONCE_REWRITE_TAC [GSYM REAL_SUB_LE] THEN REWRITE_TAC [GSYM REAL_SUB_LDISTRIB] THEN
        MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC real_ss [] THEN
        ASM_SIMP_TAC std_ss [REAL_LE_LT, GSYM REAL_OF_NUM_ADD,
           METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0] ``&0 < &n + &1:real``] THEN
        DISJ2_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC [REAL_SUB_0] THEN
        MATCH_MP_TAC REAL_MUL_LINV THEN SIMP_TAC real_ss [REAL_POS],
        (* goal 1.1.2 (of 2) *)
        RW_TAC real_ss [min_def] THEN
        NTAC 3 (POP_ASSUM MP_TAC) >> REAL_ARITH_TAC ],
      (* goal 1.2 (of 2) *)
      ONCE_REWRITE_TAC [METIS [] ``(\x. inv (&(i + 1)) * (f:num->real->real) n x) =
                             (\x. inv (&(i + 1)) * (\x. f n x) x)``] THEN
      KNOW_TAC ``(\x. (f:num->real->real) n x) integrable_on s`` THENL
      [METIS_TAC [ETA_AX], DISCH_TAC] THEN
      ASM_SIMP_TAC real_ss [INTEGRAL_CMUL] THEN
      ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
      SIMP_TAC real_ss [REAL_LE_RDIV_EQ] THEN
      SIMP_TAC real_ss [REAL_MUL_LINV, GSYM REAL_MUL_ASSOC] THEN
      MATCH_MP_TAC(REAL_ARITH ``abs x <= a ==> x <= a:real``) THEN
      METIS_TAC [ETA_AX] ],
    (* goal 2 (of 2) *)
    ALL_TAC ] THEN
  KNOW_TAC ``(!(x :real).
    x IN (s :real -> bool) ==>
    (((\(k :num). (h :num -> real -> real) k x) -->
      if x IN (Z :real -> bool) then (1 :real) else (0 :real))
       sequentially :bool)) /\
   (bounded {integral s (h k) | k | T} :bool)`` THENL
  [ (* goal 1 (of 2) *)
    SIMP_TAC std_ss [bounded_def, FORALL_IN_GSPEC] THEN CONJ_TAC THENL
     [ALL_TAC,
      EXISTS_TAC ``B:real`` THEN X_GEN_TAC ``i:num`` THEN
      MATCH_MP_TAC REAL_LE_TRANS THEN
      EXISTS_TAC ``B / (&i + &1:real)`` THEN ASM_REWRITE_TAC[] THEN
      ASM_SIMP_TAC real_ss [REAL_LE_LDIV_EQ] THEN
      REWRITE_TAC[GSYM REAL_OF_NUM_ADD,
       REAL_ARITH ``B <= B * (i + &1) <=> &0:real <= i * B``] THEN
      ASM_SIMP_TAC std_ss [REAL_LE_MUL, REAL_POS, REAL_LT_IMP_LE]] THEN
    X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
    ASM_CASES_TAC ``(x:real) IN Z`` THEN ASM_REWRITE_TAC[] THENL
    [ (* goal 1.1 (of 2) *)
      MATCH_MP_TAC LIM_EVENTUALLY THEN
      UNDISCH_TAC ``(x:real) IN Z`` THEN EXPAND_TAC "Z" THEN
      SIMP_TAC std_ss [GSPECIFICATION] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
      MP_TAC(GEN ``B:real`` (ISPECL
        [``(\n. (f:num->real->real) (n:num) (x:real))``, ``B:real``]
        CONVERGENT_BOUNDED_MONOTONE)) THEN
      SIMP_TAC std_ss [LEFT_FORALL_IMP_THM, LEFT_EXISTS_AND_THM] THEN
      MATCH_MP_TAC(TAUT
       `q /\ ~r /\ (q ==> ~p ==> s)
        ==> (p /\ (q \/ q') ==> r) ==> s`) THEN
      CONJ_TAC THENL
       [ONCE_REWRITE_TAC [METIS [] ``f m x <= (f:num->real->real) n x <=>
                              (\m n. f m x <= f n x) m n``] THEN
        MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
        METIS_TAC [REAL_LE_REFL, REAL_LE_TRANS],
        ALL_TAC] THEN
      CONJ_TAC THENL
       [FIRST_X_ASSUM(MP_TAC o SIMP_RULE std_ss [NOT_EXISTS_THM]) THEN
        ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN SIMP_TAC std_ss [] THEN
        DISCH_THEN(X_CHOOSE_THEN ``l:real`` STRIP_ASSUME_TAC) THEN
        EXISTS_TAC ``l:real`` THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN
        X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
        FIRST_X_ASSUM(MP_TAC o SPEC ``e:real``) THEN ASM_REWRITE_TAC[] THEN
        SIMP_TAC std_ss [dist],
        ALL_TAC] THEN
      DISCH_TAC THEN SIMP_TAC std_ss [NOT_FORALL_THM, EVENTUALLY_SEQUENTIALLY] THEN
      SIMP_TAC std_ss [NOT_EXISTS_THM, NOT_FORALL_THM, REAL_NOT_LE] THEN
      DISCH_TAC THEN
      EXISTS_TAC ``0:num`` THEN  X_GEN_TAC ``i:num`` THEN DISCH_TAC THEN
      MATCH_MP_TAC(ISPEC ``sequentially`` LIM_UNIQUE) THEN
      EXISTS_TAC ``(\n. (g:num->num->real->real) i n x)`` THEN
      ASM_SIMP_TAC std_ss [TRIVIAL_LIMIT_SEQUENTIALLY] THEN
      MATCH_MP_TAC LIM_EVENTUALLY THEN
      EXPAND_TAC "g" THEN SIMP_TAC std_ss [EVENTUALLY_SEQUENTIALLY] THEN
      FIRST_X_ASSUM(MP_TAC o SPEC ``&i + &1:real``) THEN
      DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
      X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN
      KNOW_TAC ``!a b. (min a b = b) <=> b <= a:real`` THENL
      [ RW_TAC real_ss [min_def] THEN
        POP_ASSUM MP_TAC >> REAL_ARITH_TAC, DISCH_TAC ] THEN
      FIRST_X_ASSUM (fn th => REWRITE_TAC [th]) THEN
      SIMP_TAC real_ss [REAL_LE_RDIV_EQ, REAL_MUL_LID] THEN
      UNDISCH_TAC ``&i + 1 < abs ((f:num->real->real) N x)`` THEN DISCH_TAC THEN
      REWRITE_TAC [GSYM REAL_OF_NUM_ADD] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
       ``a < abs N ==> &0 <= N:real /\ N <= n ==> a <= n:real``)) THEN
      ASM_SIMP_TAC std_ss [],
      (* goal 1.2 (of 2) *)
      UNDISCH_TAC ``~((x:real) IN Z)`` THEN EXPAND_TAC "Z" THEN
      SIMP_TAC std_ss [GSPECIFICATION] THEN
      ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
      X_GEN_TAC ``l:real`` THEN
      DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN
      SIMP_TAC std_ss [BOUNDED_POS, FORALL_IN_IMAGE, IN_UNIV] THEN
      DISCH_THEN(X_CHOOSE_THEN ``C:real`` STRIP_ASSUME_TAC) THEN
      SIMP_TAC std_ss [LIM_SEQUENTIALLY, DIST_0] THEN
      X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
      MP_TAC(ISPEC ``e / C:real`` REAL_ARCH_INV) THEN
      ASM_SIMP_TAC std_ss [REAL_LT_DIV] THEN
      DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
      POP_ASSUM MP_TAC THEN ASM_SIMP_TAC real_ss [REAL_LT_RDIV_EQ] THEN STRIP_TAC THEN
      X_GEN_TAC ``i:num`` THEN DISCH_TAC THEN
      MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ``inv(&N) * C:real`` THEN
      ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``C / (&i + &1:real)`` THEN
      CONJ_TAC THENL
       [ALL_TAC,
        REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN
        ASM_SIMP_TAC real_ss [REAL_LE_RMUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
        ASM_REWRITE_TAC[REAL_LT, REAL_OF_NUM_LE, REAL_OF_NUM_ADD] THEN
        ASM_SIMP_TAC arith_ss []] THEN
      MATCH_MP_TAC(ISPEC ``sequentially`` LIM_ABS_UBOUND) THEN
      EXISTS_TAC ``\n. (g:num->num->real->real) i n x`` THEN
      ASM_SIMP_TAC std_ss [TRIVIAL_LIMIT_SEQUENTIALLY] THEN
      MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC ``n:num`` THEN
      EXPAND_TAC "g" THEN SIMP_TAC std_ss [] THEN
      KNOW_TAC ``!a x:real. &0 <= x /\ x <= a ==> abs(min x (&1)) <= a`` THENL
      [ RW_TAC real_ss [min_def] THEN
        NTAC 3 (POP_ASSUM MP_TAC) >> REAL_ARITH_TAC, DISCH_TAC ] THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_SIMP_TAC real_ss [REAL_LE_DIV, REAL_LE_ADD, REAL_POS] THEN
      REWRITE_TAC [real_div] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN
      ASM_SIMP_TAC std_ss [GSYM REAL_OF_NUM_ADD,
       METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0] ``&0 < &n + &1:real``] THEN
      SIMP_TAC std_ss [REAL_LE_REFL] THEN CONJ_TAC THENL
      [MATCH_MP_TAC REAL_LE_INV THEN SIMP_TAC real_ss [REAL_POS], ALL_TAC] THEN
      MATCH_MP_TAC(REAL_ARITH ``abs x <= a ==> x <= a:real``) THEN
      ASM_SIMP_TAC real_ss [] ],
    (* goal 2 (of 2) *)
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    MATCH_MP_TAC(MESON[LIM_UNIQUE, TRIVIAL_LIMIT_SEQUENTIALLY]
     ``(f --> 0) sequentially /\ ((i = 0) ==> p)
      ==> (f --> i) sequentially ==> p``) THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC LIM_NULL_COMPARISON THEN
      EXISTS_TAC ``\i. B / (&i + &1:real)`` THEN
      ASM_SIMP_TAC std_ss [ALWAYS_EVENTUALLY] THEN
      REWRITE_TAC[real_div] THEN
      SUBST1_TAC(REAL_ARITH ``0:real = B * 0``) THEN
      ONCE_REWRITE_TAC [METIS [] ``(\x. B * inv (&x + 1:real)) =
                              (\x. B * (\x. inv (&x + 1)) x)``] THEN
      MATCH_MP_TAC LIM_CMUL THEN
      SIMP_TAC std_ss [LIM_SEQUENTIALLY, DIST_0] THEN
      X_GEN_TAC ``e:real`` THEN GEN_REWR_TAC LAND_CONV [REAL_ARCH_INV] THEN
      DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
      POP_ASSUM MP_TAC THEN STRIP_TAC THEN X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN
      SIMP_TAC real_ss [ABS_INV] THEN
      MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ``inv(&N:real)`` THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
      SIMP_TAC real_ss [METIS [abs, REAL_OF_NUM_ADD, REAL_POS]
       ``abs(&(n + &1)) = &n + &1:real``] THEN
      ASM_SIMP_TAC arith_ss [],
      ASM_SIMP_TAC std_ss [INTEGRAL_EQ_HAS_INTEGRAL] THEN
      W(MP_TAC o PART_MATCH (lhs o rand) HAS_INTEGRAL_NEGLIGIBLE_EQ o
        lhand o snd) THEN SIMP_TAC std_ss [] THEN
      KNOW_TAC ``(!x:real. x IN s ==> 0 <= if x IN Z then 1 else 0:real)`` THENL
       [SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
        REWRITE_TAC[AND_IMP_INTRO] THEN
        REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
        REWRITE_TAC[REAL_POS],
        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
        DISCH_THEN SUBST1_TAC THEN
        MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN
        SIMP_TAC arith_ss [SUBSET_DEF, GSPECIFICATION] THEN
        EXPAND_TAC "Z" THEN SIMP_TAC real_ss [GSPECIFICATION]]] ]
QED

val BEPPO_LEVI_DECREASING = store_thm ("BEPPO_LEVI_DECREASING",
 ``!f:num->real->real s.
        (!k. (f k) integrable_on s) /\
        (!k x. x IN s ==> (f (SUC k) x) <= (f k x)) /\
        bounded {integral s (f k) | k IN univ(:num)}
        ==> ?g k. negligible k /\
                  !x. x IN (s DIFF k) ==> ((\k. f k x) --> g x) sequentially``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [``\n x. -((f:num->real->real) n x)``, ``s:real->bool``]
        BEPPO_LEVI_INCREASING) THEN
  ASM_SIMP_TAC std_ss [INTEGRABLE_NEG, ETA_AX, REAL_LE_NEG2] THEN
  ASM_SIMP_TAC real_ss [METIS [INTEGRABLE_NEG, ETA_AX]
   ``(!k. (f:num->real->real) k integrable_on s) ==>
              (!k. (\x. -f k x) integrable_on s)``] THEN
  KNOW_TAC ``(bounded
    {integral s (\(x :real). -(f :num -> real -> real) k x) |
      k IN univ((:num) :num itself)} : bool)`` THENL
   [REWRITE_TAC[bounded_def] THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [bounded_def]) THEN
    SIMP_TAC std_ss [FORALL_IN_GSPEC] THEN
    METIS_TAC [INTEGRAL_NEG, ETA_AX, ABS_NEG],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    KNOW_TAC ``(?(k :real -> bool) (g :real -> real).
     negligible k /\ !(x :real).
     x IN (s :real -> bool) DIFF k ==>
     (((\(k :num). -(f :num -> real -> real) k x) --> g x)
        sequentially :bool)) ==>
     ?(k :real -> bool) (g :real -> real). negligible k /\ !(x :real).
      x IN s DIFF k ==> (((\(k :num). f k x) --> g x) sequentially :bool)`` THENL
    [ALL_TAC, METIS_TAC [SWAP_EXISTS_THM]] THEN
    DISCH_THEN (X_CHOOSE_TAC ``k:real->bool``) THEN EXISTS_TAC ``k:real->bool`` THEN
    POP_ASSUM MP_TAC THEN
    DISCH_THEN(X_CHOOSE_THEN ``g:real->real`` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC ``\x. -((g:real->real) x)`` THEN
    ASM_SIMP_TAC std_ss [] THEN REPEAT STRIP_TAC THEN
    GEN_REWR_TAC (RATOR_CONV o LAND_CONV o ABS_CONV)
      [GSYM REAL_NEG_NEG] THEN
    ASM_SIMP_TAC std_ss [LIM_NEG_EQ]]);

val BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING = store_thm ("BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING",
 ``!f:num->real->real s.
        (!k. (f k) integrable_on s) /\
        (!k x. x IN s ==> (f k x) <= (f (SUC k) x)) /\
        bounded {integral s (f k) | k IN univ(:num)}
        ==> ?g k. negligible k /\
                  (!x. x IN (s DIFF k)
                       ==> ((\k. f k x) --> g x) sequentially) /\
                  g integrable_on s /\
                  ((\k. integral s (f k)) --> integral s g) sequentially``,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP BEPPO_LEVI_INCREASING) THEN
  DISCH_THEN (X_CHOOSE_THEN ``g:real->real`` MP_TAC) THEN
  DISCH_THEN (X_CHOOSE_TAC ``k:real->bool``) THEN
  EXISTS_TAC ``g:real->real`` THEN EXISTS_TAC ``k:real->bool`` THEN
  POP_ASSUM MP_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC std_ss [] THEN
  SUBGOAL_THEN
   ``(g:real->real) integrable_on (s DIFF k) /\
     ((\i. integral (s DIFF k) (f i)) --> integral (s DIFF k) g) sequentially``
  MP_TAC THENL
   [MATCH_MP_TAC MONOTONE_CONVERGENCE_INCREASING THEN
    ASM_SIMP_TAC std_ss [] THEN
    UNDISCH_TAC ``(!k. f k integrable_on s) /\
      (!k x. x IN s ==> f k x <= f (SUC k) x) /\
      bounded {integral s (f k) | k IN univ(:num)}``,
    ALL_TAC] THEN
  (SUBGOAL_THEN
    ``!f:real->real. (integral (s DIFF k) f = integral s f) /\
                        (f integrable_on (s DIFF k) <=> f integrable_on s)``
    (fn th => SIMP_TAC std_ss [th, IN_DIFF]) THEN
   GEN_TAC THEN CONJ_TAC THEN TRY EQ_TAC THEN
   (MATCH_MP_TAC INTEGRABLE_SPIKE_SET ORELSE
    MATCH_MP_TAC INTEGRAL_SPIKE_SET) THEN
   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        NEGLIGIBLE_SUBSET)) THEN
     SET_TAC[]));

val BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING = store_thm ("BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING",
 ``!f:num->real->real s.
        (!k. (f k) integrable_on s) /\
        (!k x. x IN s ==> (f (SUC k) x) <= (f k x)) /\
        bounded {integral s (f k) | k IN univ(:num)}
        ==> ?g k. negligible k /\
                  (!x. x IN (s DIFF k)
                       ==> ((\k. f k x) --> g x) sequentially) /\
                  g integrable_on s /\
                  ((\k. integral s (f k)) --> integral s g) sequentially``,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP BEPPO_LEVI_DECREASING) THEN
  DISCH_THEN (X_CHOOSE_THEN ``g:real->real`` MP_TAC) THEN
  DISCH_THEN (X_CHOOSE_TAC ``k:real->bool``) THEN
  EXISTS_TAC ``g:real->real`` THEN EXISTS_TAC ``k:real->bool`` THEN
  POP_ASSUM MP_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  SUBGOAL_THEN
   ``(g:real->real) integrable_on (s DIFF k) /\
    ((\i. integral (s DIFF k) (f i)) --> integral (s DIFF k) g) sequentially``
  MP_TAC THENL
   [MATCH_MP_TAC MONOTONE_CONVERGENCE_DECREASING THEN
    ASM_SIMP_TAC std_ss [] THEN
    UNDISCH_TAC `` (!k. f k integrable_on s) /\
      (!k x. x IN s ==> f (SUC k) x <= f k x) /\
      bounded {integral s (f k) | k IN univ(:num)}``,
    ALL_TAC] THEN
  (SUBGOAL_THEN
    ``!f:real->real. (integral (s DIFF k) f = integral s f) /\
                        (f integrable_on (s DIFF k) <=> f integrable_on s)``
    (fn th => SIMP_TAC std_ss [th, IN_DIFF]) THEN
   GEN_TAC THEN CONJ_TAC THEN TRY EQ_TAC THEN
   (MATCH_MP_TAC INTEGRABLE_SPIKE_SET ORELSE
    MATCH_MP_TAC INTEGRAL_SPIKE_SET) THEN
   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        NEGLIGIBLE_SUBSET)) THEN
     SET_TAC[]));

val BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING_AE = store_thm ("BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING_AE",
 ``!f:num->real->real s.
        (!k. (f k) integrable_on s) /\
        (!k. ?t. negligible t /\
                 !x. x IN s DIFF t ==> (f k x) <= (f (SUC k) x)) /\
        bounded {integral s (f k) | k IN univ(:num)}
        ==> ?g k. negligible k /\
                  (!x. x IN (s DIFF k)
                       ==> ((\k. f k x) --> g x) sequentially) /\
                  g integrable_on s /\
                  ((\k. integral s (f k)) --> integral s g) sequentially``,
  REPEAT GEN_TAC THEN SIMP_TAC std_ss [SKOLEM_THM] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  SIMP_TAC std_ss [FORALL_AND_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN ``t:num->real->bool`` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL
   [``\n x. if x IN BIGUNION {t k | k IN univ(:num)} then 0
           else (f:num->real->real) n x``, ``s:real->bool``]
        BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING) THEN
  SUBGOAL_THEN
   ``negligible(BIGUNION {t k | k IN univ(:num)}:real->bool)``
  ASSUME_TAC THENL [ASM_SIMP_TAC std_ss [NEGLIGIBLE_COUNTABLE_BIGUNION], ALL_TAC] THEN
  ASM_SIMP_TAC std_ss [] THEN
  KNOW_TAC ``(!(k :num). (\(x :real).
       if x IN BIGUNION
           {(t :num -> real -> bool) k | k IN univ((:num) :num itself)}
       then (0 : real)
       else (f :num -> real -> real) k x) integrable_on (s :real -> bool)) /\
             (!(k :num) (x :real). x IN s ==>
    (if x IN BIGUNION {t k | k IN univ((:num) :num itself)} then
       (0 : real) else f k x) <=
    if x IN BIGUNION {t k | k IN univ((:num) :num itself)} then
      (0 : real) else f (SUC k) x) /\
    (bounded {integral s (\(x :real).
          if x IN BIGUNION {t k | k IN univ((:num) :num itself)} then
            (0 : real) else f k x) |
     k IN univ((:num) :num itself)} :bool)`` THENL
   [REPEAT CONJ_TAC THENL
     [X_GEN_TAC ``k:num`` THEN
      MATCH_MP_TAC(REWRITE_RULE[AND_IMP_INTRO] INTEGRABLE_SPIKE) THEN
      EXISTS_TAC ``(f:num->real->real) k`` THEN
      EXISTS_TAC ``BIGUNION {t k | k IN univ(:num)}:real->bool`` THEN
      ASM_SIMP_TAC std_ss [IN_DIFF],
      REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
      ASM_REWRITE_TAC[REAL_LE_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_SET_TAC[],
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        BOUNDED_SUBSET)) THEN
      KNOW_TAC ``{(\k. integral (s :real -> bool)
       (\(x :real). if x IN BIGUNION
          {(t :num -> real -> bool) k | k IN univ((:num) :num itself)}
      then (0 : real)
      else (f :num -> real -> real) k x)) k |
       k IN univ((:num) :num itself)} SUBSET
       {(\k. integral s (f k)) k | k IN univ((:num) :num itself)}`` THENL
      [ALL_TAC, METIS_TAC []] THEN
      MATCH_MP_TAC(SET_RULE
       ``(!x. x IN s ==> (f x = g x))
        ==> {f x | x IN s} SUBSET {g x | x IN s}``) THEN SIMP_TAC std_ss [] THEN
      REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN
      EXISTS_TAC ``BIGUNION {t k | k IN univ(:num)}:real->bool`` THEN
      ASM_SIMP_TAC std_ss [IN_DIFF]],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    DISCH_THEN (X_CHOOSE_TAC ``g:real->real``) THEN
    EXISTS_TAC ``g:real->real`` THEN POP_ASSUM MP_TAC THEN
    DISCH_THEN(X_CHOOSE_THEN ``u:real->bool`` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC ``u UNION BIGUNION {t k | k IN univ(:num)}:real->bool`` THEN
    ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN CONJ_TAC THENL
     [X_GEN_TAC ``x:real`` THEN
      REWRITE_TAC[IN_DIFF, IN_UNION, DE_MORGAN_THM] THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN
      ASM_REWRITE_TAC[IN_DIFF],
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
         ``(f --> l) sequentially ==> (f = g) ==> (g --> l) sequentially``)) THEN
      SIMP_TAC std_ss [FUN_EQ_THM] THEN GEN_TAC THEN
      MATCH_MP_TAC INTEGRAL_SPIKE THEN
      EXISTS_TAC ``BIGUNION {t k | k IN univ(:num)}:real->bool`` THEN
      ASM_SIMP_TAC std_ss [IN_DIFF]]]);

val BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING_AE = store_thm ("BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING_AE",
 ``!f:num->real->real s.
        (!k. (f k) integrable_on s) /\
        (!k. ?t. negligible t /\
                 !x. x IN s DIFF t ==> (f (SUC k) x) <= (f k x)) /\
        bounded {integral s (f k) | k IN univ(:num)}
        ==> ?g k. negligible k /\
                  (!x. x IN (s DIFF k)
                       ==> ((\k. f k x) --> g x) sequentially) /\
                  g integrable_on s /\
                  ((\k. integral s (f k)) --> integral s g) sequentially``,
  REPEAT GEN_TAC THEN SIMP_TAC std_ss [SKOLEM_THM] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  SIMP_TAC std_ss [FORALL_AND_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN ``t:num->real->bool`` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL
   [``\n x. if x IN BIGUNION {t k | k IN univ(:num)} then 0
           else (f:num->real->real) n x``, ``s:real->bool``]
        BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING) THEN
  SUBGOAL_THEN
   ``negligible(BIGUNION {t k | k IN univ(:num)}:real->bool)``
  ASSUME_TAC THENL [ASM_SIMP_TAC std_ss [NEGLIGIBLE_COUNTABLE_BIGUNION], ALL_TAC] THEN
  ASM_SIMP_TAC std_ss [] THEN
  KNOW_TAC ``(!(k :num). (\(x :real).
       if x IN BIGUNION
           {(t :num -> real -> bool) k | k IN univ((:num) :num itself)}
       then (0 : real)
       else (f :num -> real -> real) k x) integrable_on (s :real -> bool)) /\
     (!(k :num) (x :real). x IN s ==>
    (if x IN BIGUNION {t k | k IN univ((:num) :num itself)} then
       (0 : real) else f (SUC k) x) <=
    if x IN BIGUNION {t k | k IN univ((:num) :num itself)} then
      (0 : real)
    else f k x) /\ (bounded
    {integral s (\(x :real).
          if x IN BIGUNION {t k | k IN univ((:num) :num itself)} then
            (0 : real)
          else f k x) | k IN univ((:num) :num itself)} :bool)`` THENL
   [REPEAT CONJ_TAC THENL
     [X_GEN_TAC ``k:num`` THEN
      MATCH_MP_TAC(REWRITE_RULE[AND_IMP_INTRO] INTEGRABLE_SPIKE) THEN
      EXISTS_TAC ``(f:num->real->real) k`` THEN
      EXISTS_TAC ``BIGUNION {t k | k IN univ(:num)}:real->bool`` THEN
      ASM_SIMP_TAC std_ss [IN_DIFF],
      REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
      ASM_SIMP_TAC std_ss [REAL_LE_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_SET_TAC[],
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        BOUNDED_SUBSET)) THEN
       KNOW_TAC ``{(\k. integral (s :real -> bool)
       (\(x :real). if x IN BIGUNION
          {(t :num -> real -> bool) k | k IN univ((:num) :num itself)}
      then (0 : real)
      else (f :num -> real -> real) k x)) k |
       k IN univ((:num) :num itself)} SUBSET
       {(\k. integral s (f k)) k | k IN univ((:num) :num itself)}`` THENL
      [ALL_TAC, METIS_TAC []] THEN
      MATCH_MP_TAC(SET_RULE
       ``(!x. x IN s ==> (f x = g x))
        ==> {f x | x IN s} SUBSET {g x | x IN s}``) THEN SIMP_TAC std_ss [] THEN
      REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN
      EXISTS_TAC ``BIGUNION {t k | k IN univ(:num)}:real->bool`` THEN
      ASM_SIMP_TAC std_ss [IN_DIFF]],

    DISCH_TAC THEN ASM_SIMP_TAC std_ss [] THEN POP_ASSUM K_TAC THEN
    DISCH_THEN (X_CHOOSE_TAC ``g:real->real``) THEN
    EXISTS_TAC ``g:real->real`` THEN POP_ASSUM MP_TAC THEN
    DISCH_THEN(X_CHOOSE_THEN ``u:real->bool`` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC ``u UNION BIGUNION {t k | k IN univ(:num)}:real->bool`` THEN
    ASM_SIMP_TAC std_ss [NEGLIGIBLE_UNION_EQ] THEN CONJ_TAC THENL
     [X_GEN_TAC ``x:real`` THEN
      REWRITE_TAC[IN_DIFF, IN_UNION, DE_MORGAN_THM] THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN
      ASM_REWRITE_TAC[IN_DIFF],
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
         ``(f --> l) sequentially ==> (f = g) ==> (g --> l) sequentially``)) THEN
      SIMP_TAC std_ss [FUN_EQ_THM] THEN GEN_TAC THEN
      MATCH_MP_TAC INTEGRAL_SPIKE THEN
      EXISTS_TAC ``BIGUNION {t k | k IN univ(:num)}:real->bool`` THEN
      ASM_SIMP_TAC std_ss [IN_DIFF]]]);

(* ------------------------------------------------------------------------- *)
(* Fatou's lemma and Lieb's extension.                                       *)
(* ------------------------------------------------------------------------- *)

val FATOU = store_thm ("FATOU",
 ``!f:num->real->real g s t B.
        negligible t /\
        (!n. (f n) integrable_on s) /\
        (!n x. x IN s DIFF t ==> &0 <= (f n x)) /\
        (!x. x IN s DIFF t ==> ((\n. f n x) --> g x) sequentially) /\
        (!n. (integral s (f n)) <= B)
        ==> g integrable_on s /\
            &0 <= (integral s g) /\ (integral s g) <= B``,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  ABBREV_TAC
   ``h = \n x. (inf {((f:num->real->real) j x) | n <= j})`` THEN
  MP_TAC((GEN ``m:num``
   (ISPECL [``\k:num x:real. (inf {(f j x) | j IN m..(m+k)})``,
            ``(h:num->real->real) m``,
            ``s:real->bool``, ``t:real->bool``]
           MONOTONE_CONVERGENCE_DECREASING_AE))) THEN
  ASM_SIMP_TAC std_ss [] THEN
  KNOW_TAC ``!(m :num).
   (!(k :num).
      (\(x :real).
         inf
           {(f :num -> real -> real) j x |
            j IN m .. m + k}) integrable_on (s :real -> bool)) /\
   (!(k :num) (x :real).
      x IN s DIFF (t :real -> bool) ==>
      inf {f j x | j IN m .. m + SUC k} <=
      inf {f j x | j IN m .. m + k}) /\
   (!(x :real).
      x IN s DIFF t ==>
      (((\(k :num). inf {f j x | j IN m .. m + k}) -->
        (h :num -> real -> real) m x) sequentially :bool)) /\
   (bounded
      {integral s (\(x :real). inf {f j x | j IN m .. m + k}) |
       k IN univ((:num) :num itself)} :bool)`` THENL
   [X_GEN_TAC ``m:num`` THEN EXPAND_TAC "h" THEN SIMP_TAC std_ss [] THEN
    REPEAT CONJ_TAC THENL
     [GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
      SIMP_TAC real_ss [GSYM IMAGE_DEF] THEN
      REWRITE_TAC [METIS [] ``(\x. inf (IMAGE (\j. f j x) (m .. k + m))) =
                    (\x. inf (IMAGE ((\x. (\j. f j x)) x) (m .. k + m)))``] THEN
      MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INF THEN
      SIMP_TAC std_ss [FINITE_NUMSEG, NUMSEG_EMPTY, NOT_LESS, LE_ADD] THEN
      ASM_SIMP_TAC std_ss [METIS [ETA_AX] ``(\x. f i x) = f i``] THEN
      REPEAT STRIP_TAC THEN
      MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE THEN
      EXISTS_TAC ``t:real->bool`` THEN
      ASM_SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
      ASM_SIMP_TAC std_ss [AND_IMP_INTRO],
      REPEAT STRIP_TAC THEN SIMP_TAC real_ss [GSYM IMAGE_DEF] THEN
      MATCH_MP_TAC REAL_LE_INF_SUBSET THEN
      SIMP_TAC std_ss [IMAGE_EQ_EMPTY, NUMSEG_EMPTY, NOT_LESS, LE_ADD] THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC IMAGE_SUBSET THEN
        REWRITE_TAC[SUBSET_NUMSEG] THEN ARITH_TAC,
        ALL_TAC] THEN
      SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN
      ONCE_REWRITE_TAC [METIS []
       ``b <= f j x <=> (b <= (\j. (f:num->real->real) j x) j)``] THEN
      MATCH_MP_TAC LOWER_BOUND_FINITE_SET_REAL THEN
      REWRITE_TAC[FINITE_NUMSEG],
      X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
      REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
      REWRITE_TAC[dist] THEN
      MP_TAC(SPEC ``{((f:num->real->real) j x) | m <= j}`` INF) THEN
      ABBREV_TAC ``i = inf {((f:num->real->real) j x) | m <= j}`` THEN
      REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN] ``{(f:num->real->real) j x | m <= j} =
                                                  IMAGE (\j. f j x) {j | m <= j}``] THEN
      SIMP_TAC std_ss [FORALL_IN_IMAGE, EXISTS_IN_IMAGE, IMAGE_EQ_EMPTY] THEN
      SIMP_TAC std_ss [GSPECIFICATION, EXTENSION, NOT_IN_EMPTY] THEN
      KNOW_TAC ``(?x. m <= x) /\ (?b. !j. m <= j ==>
                 b <= (f:num->real->real) j x)`` THENL
      [ASM_MESON_TAC[LESS_EQ_REFL],
       DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC ``i + e:real``)) THEN
      ASM_SIMP_TAC std_ss [REAL_ARITH ``&0 < e ==> ~(i + e <= i:real)``] THEN
      SIMP_TAC std_ss [NOT_FORALL_THM, NOT_IMP, REAL_NOT_LE] THEN
      DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
      X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN
      REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN] ``{(f:num->real->real) j x | j IN s} =
                                                  IMAGE (\j. f j x) {j | j IN s}``] THEN
      UNDISCH_TAC ``m <= N /\ (f:num->real->real) N x < i + e`` THEN STRIP_TAC THEN
      FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
       ``y < i + e ==> i <= ix /\ ix <= y ==> abs(ix - i) < e:real``)) THEN
      CONJ_TAC THENL
       [EXPAND_TAC "i" THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN
        SIMP_TAC real_ss [IMAGE_EQ_EMPTY, SET_RULE ``{x | x IN s} = s``] THEN
        REWRITE_TAC[NUMSEG_EMPTY, NOT_LESS, LE_ADD] THEN
        REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN]
        ``{(f:num->real->real) j x | m <= j} =
          IMAGE (\j. f j x) {j | m <= j}``] THEN
        CONJ_TAC THENL
         [MATCH_MP_TAC IMAGE_SUBSET THEN
          SIMP_TAC std_ss [SUBSET_DEF, IN_NUMSEG, GSPECIFICATION] THEN ARITH_TAC,
          SIMP_TAC std_ss [FORALL_IN_IMAGE, GSPECIFICATION] THEN ASM_MESON_TAC[]],
        ALL_TAC] THEN
      W(MP_TAC o C SPEC INF o rand o lhand o snd) THEN
      KNOW_TAC ``IMAGE (\(j :num). (f :num -> real -> real) j (x :real))
       {j | j IN (m :num) .. m + (n :num)} <> ({} :real -> bool) /\
       (?(b :real). !(x' :real).
        x' IN IMAGE (\(j :num). f j x) {j | j IN m .. m + n} ==>
        b <= x')`` THENL
       [SIMP_TAC std_ss [IMAGE_EQ_EMPTY, SET_RULE ``{x | x IN s} = s``] THEN
        REWRITE_TAC[NUMSEG_EMPTY, NOT_LESS, LE_ADD] THEN
        SIMP_TAC std_ss [FORALL_IN_IMAGE, GSPECIFICATION] THEN
        EXISTS_TAC ``i:real`` THEN GEN_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN
        DISCH_THEN(fn th => FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN
        ARITH_TAC,
        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
      SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN
      DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN
      SIMP_TAC std_ss [GSPECIFICATION, IN_NUMSEG] THEN
      ASM_SIMP_TAC arith_ss [],
      REWRITE_TAC[bounded_def] THEN EXISTS_TAC ``B:real`` THEN
      SIMP_TAC std_ss [FORALL_IN_GSPEC, IN_UNIV] THEN
      X_GEN_TAC ``n:num`` THEN
      MATCH_MP_TAC(REAL_ARITH ``&0 <= x /\ x <= b ==> abs(x) <= b:real``) THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC INTEGRAL_DROP_POS_AE THEN
        EXISTS_TAC ``t:real->bool`` THEN ASM_REWRITE_TAC[] THEN
        CONJ_TAC THENL
         [ALL_TAC,
          REPEAT STRIP_TAC THEN SIMP_TAC std_ss [] THEN MATCH_MP_TAC REAL_LE_INF THEN
          ASM_SIMP_TAC real_ss [GSYM IMAGE_DEF, FORALL_IN_IMAGE, IMAGE_EQ_EMPTY] THEN
         SIMP_TAC std_ss [NUMSEG_EMPTY, NOT_LESS, LE_ADD]],
       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
          ``(integral s ((f:num->real->real) m))`` THEN
        ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN
        ASM_SIMP_TAC std_ss [] THEN CONJ_TAC THENL
         [ALL_TAC,
          SIMP_TAC real_ss [REAL_INF_LE_FINITE, GSYM IMAGE_DEF,
                   IMAGE_FINITE, IMAGE_EQ_EMPTY, FINITE_NUMSEG, IN_NUMSEG,
                   NUMSEG_EMPTY, NOT_LESS, LE_ADD, EXISTS_IN_IMAGE] THEN
          MESON_TAC[REAL_LE_REFL, LESS_EQ_REFL, LE_ADD]]] THEN
      MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
      SIMP_TAC real_ss [GSYM IMAGE_DEF] THEN
      REWRITE_TAC [METIS [] ``(\x. inf (IMAGE (\j. f j x) (m .. m + n))) =
                    (\x. inf (IMAGE ((\x. (\j. f j x)) x) (m .. m + n)))``] THEN
      MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INF THEN
      SIMP_TAC std_ss [FINITE_NUMSEG, NUMSEG_EMPTY, NOT_LESS, LE_ADD] THEN
      ASM_SIMP_TAC std_ss [METIS [ETA_AX] ``(\x. f i x) = f i``] THEN
      REPEAT STRIP_TAC THEN
      MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE THEN
      EXISTS_TAC ``t:real->bool`` THEN
      ASM_SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
      ASM_REWRITE_TAC[AND_IMP_INTRO]], ALL_TAC] THEN
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
  MP_TAC(ISPECL [``h:num->real->real``, ``g:real->real``,
                 ``s:real->bool``, ``t:real->bool``]
    MONOTONE_CONVERGENCE_INCREASING_AE) THEN
  ASM_SIMP_TAC std_ss [] THEN
  SUBGOAL_THEN
   ``!n. &0 <= (integral s ((h:num->real->real) n)) /\
        (integral s ((h:num->real->real) n)) <= B``
  MP_TAC THENL
   [X_GEN_TAC ``m:num`` THEN CONJ_TAC THENL
     [MATCH_MP_TAC INTEGRAL_DROP_POS_AE THEN
      EXISTS_TAC ``t:real->bool`` THEN ASM_SIMP_TAC std_ss [] THEN
      EXPAND_TAC "h" THEN SIMP_TAC std_ss [] THEN
      REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_INF THEN
      REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN] ``{(f:num->real->real) j x | m <= j} =
                                                  IMAGE (\j. f j x) {j | m <= j}``] THEN
      ASM_SIMP_TAC std_ss [FORALL_IN_IMAGE, IMAGE_EQ_EMPTY] THEN
      SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, NOT_IN_EMPTY] THEN
      MESON_TAC[LESS_EQ_REFL],
      MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
        ``(integral s ((f:num->real->real) m))`` THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRAL_LE_AE THEN
      EXISTS_TAC ``t:real->bool`` THEN ASM_REWRITE_TAC[] THEN
      REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN
      GEN_REWR_TAC RAND_CONV [GSYM INF_SING] THEN
      MATCH_MP_TAC  REAL_LE_INF_SUBSET THEN
      SIMP_TAC std_ss [NOT_INSERT_EMPTY, SING_SUBSET, FORALL_IN_GSPEC] THEN
      CONJ_TAC THENL [SIMP_TAC std_ss [GSPECIFICATION], ASM_MESON_TAC[]] THEN
      MESON_TAC[LESS_EQ_REFL, REAL_LE_REFL]],
    SIMP_TAC std_ss [FORALL_AND_THM] THEN STRIP_TAC] THEN
  KNOW_TAC ``(!(k :num) (x :real).
    x IN (s :real -> bool) DIFF (t :real -> bool) ==>
    (h :num -> real -> real) k x <= h (SUC k) x) /\
 (!(x :real).
    x IN s DIFF t ==>
    (((\(k :num). h k x) --> (g :real -> real) x) sequentially :
       bool)) /\
 (bounded {integral s (h k) | k IN univ((:num) :num itself)} :bool)`` THENL
   [REPEAT CONJ_TAC THENL
     [REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN SIMP_TAC std_ss [] THEN
      MATCH_MP_TAC REAL_LE_INF_SUBSET THEN
      REWRITE_TAC [METIS [SIMPLE_IMAGE_GEN] ``{(f:num->real->real) j x | m <= j} =
                                                  IMAGE (\j. f j x) {j | m <= j}``] THEN
      SIMP_TAC std_ss [FORALL_IN_IMAGE, IMAGE_EQ_EMPTY, FORALL_IN_GSPEC] THEN
      SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, NOT_IN_EMPTY, NOT_LESS_EQUAL] THEN
      REPEAT CONJ_TAC THENL
       [EXISTS_TAC ``k + 1:num`` THEN SIMP_TAC arith_ss [],
        MATCH_MP_TAC IMAGE_SUBSET THEN
        SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION] THEN
        SIMP_TAC arith_ss [ADD1, IN_IMAGE] THEN GEN_TAC THEN
        STRIP_TAC THEN EXISTS_TAC ``j:num`` THEN
        FULL_SIMP_TAC std_ss [GSPECIFICATION] THEN POP_ASSUM MP_TAC THEN
        ARITH_TAC,
        ASM_MESON_TAC[]],
      X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN
      ASM_REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_TAC THEN
      X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN
      ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN
      EXISTS_TAC ``N:num`` THEN POP_ASSUM MP_TAC THEN
      REWRITE_TAC[dist] THEN REPEAT STRIP_TAC THEN
      KNOW_TAC ``!h g. &0 < e /\ g - e / &2 <= h /\ h <= g + e / &2 ==>
                                                abs(h - g) < e:real`` THENL
      [ONCE_REWRITE_TAC [REAL_ARITH ``a - b <= c <=> a - c <= b:real``,
                         REAL_ARITH ``a <= b + c <=> a - b <= c:real``] THEN
       SIMP_TAC std_ss [REAL_LE_LDIV_EQ, REAL_LE_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
       REAL_ARITH_TAC, DISCH_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_SIMP_TAC std_ss [] THEN EXPAND_TAC "h" THEN SIMP_TAC std_ss [] THEN
      MATCH_MP_TAC REAL_INF_BOUNDS THEN SIMP_TAC std_ss [FORALL_IN_GSPEC] THEN
      SIMP_TAC std_ss [SET_RULE ``({f n | P n} = {}) <=> !n. ~P n``] THEN
      CONJ_TAC THENL [MESON_TAC[LESS_EQ_REFL], GEN_TAC THEN DISCH_TAC] THEN
      KNOW_TAC ``!h g. abs(h - g) < e / &2 ==>
                    g - e / &2 <= h /\ h <= g + e / &2:real`` THENL
      [ONCE_REWRITE_TAC [REAL_ARITH ``a - b <= c <=> a - c <= b:real``,
                         REAL_ARITH ``a <= b + c <=> a - b <= c:real``] THEN
       SIMP_TAC std_ss [REAL_LE_LDIV_EQ, REAL_LE_RDIV_EQ, REAL_LT_RDIV_EQ,
                         REAL_ARITH ``0 < 2:real``] THEN REAL_ARITH_TAC,
      DISCH_TAC] THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN METIS_TAC[LESS_EQ_TRANS],
      SIMP_TAC std_ss [bounded_def, FORALL_IN_GSPEC] THEN EXISTS_TAC ``B:real`` THEN
      REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN
      MATCH_MP_TAC(REAL_ARITH ``&0 <= x /\ x <= b ==> abs x <= b:real``) THEN
      ASM_REWRITE_TAC[]],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
     [MATCH_MP_TAC(ISPEC ``sequentially`` LIM_DROP_LBOUND),
      MATCH_MP_TAC(ISPEC ``sequentially`` LIM_DROP_UBOUND)] THEN
    EXISTS_TAC ``\n. integral s ((h:num->real->real) n)`` THEN
    ASM_SIMP_TAC real_ss [TRIVIAL_LIMIT_SEQUENTIALLY, EVENTUALLY_TRUE]]);

(* ------------------------------------------------------------------------- *)
(* Fundamental theorem of calculus, starting with strong forms.   12023      *)
(* ------------------------------------------------------------------------- *)

val FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG = store_thm ("FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG",
 ``!f:real->real f' s a b.
        COUNTABLE s /\
        a <= b /\ f continuous_on interval[a,b] /\
        (!x. x IN interval[a,b] DIFF s
             ==> (f has_vector_derivative f'(x)) (at x within interval[a,b]))
        ==> (f' has_integral (f(b) - f(a))) (interval[a,b])``,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN
  EXISTS_TAC ``(\x. if x IN s then 0 else f' x):real->real`` THEN
  EXISTS_TAC ``s:real->bool`` THEN
  ASM_SIMP_TAC std_ss [NEGLIGIBLE_COUNTABLE, IN_DIFF] THEN
  SUBGOAL_THEN
   ``?f t. (s = IMAGE (f:num->real) t) /\
          (!m n. m IN t /\ n IN t /\ (f m = f n) ==> (m = n))``
  MP_TAC THENL
   [ASM_CASES_TAC ``FINITE(s:real->bool)`` THENL
     [FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [FINITE_INDEX_NUMSEG]) THEN
      ASM_MESON_TAC[],
      MP_TAC(ISPEC ``s:real->bool`` COUNTABLE_AS_INJECTIVE_IMAGE) THEN
      ASM_REWRITE_TAC[] THEN MESON_TAC[IN_UNIV]],
    SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM, INJECTIVE_ON_LEFT_INVERSE] THEN
    MAP_EVERY X_GEN_TAC [``r:num->real``, ``t:num->bool``] THEN
    DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN
    DISCH_THEN(X_CHOOSE_TAC ``n:real->num``)] THEN
  REWRITE_TAC[HAS_INTEGRAL_FACTOR_CONTENT] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  SUBGOAL_THEN
   ``!x. ?d. &0 < d /\
            (x IN interval[a,b]
             ==> (x IN IMAGE (r:num->real) t
                  ==> !y. abs(y - x) < d /\ y IN interval[a,b]
                          ==> abs(f y - f x)
                              <= e / &2 pow (4 + n x) * abs(b - a)) /\
                 (~(x IN IMAGE r t)
                  ==> !y. abs(y - x) < d /\ y IN interval[a,b]
                          ==> abs(f y - f x - (y - x) * f' x:real)
                                <= e / &2 * abs(y - x)))``
  MP_TAC THENL
   [X_GEN_TAC ``x:real`` THEN
    ASM_CASES_TAC ``(x:real) IN interval[a,b]`` THENL
     [ALL_TAC, EXISTS_TAC ``&1:real`` THEN ASM_REWRITE_TAC[REAL_LT_01]] THEN
    ASM_CASES_TAC ``x IN IMAGE (r:num->real) t`` THEN ASM_REWRITE_TAC[] THENL
     [FIRST_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH
       ``a <= b ==> (a = b:real) \/ a < b``)) THEN
      REWRITE_TAC[] THEN STRIP_TAC THENL
       [EXISTS_TAC ``&1:real`` THEN REWRITE_TAC[REAL_LT_01] THEN
        UNDISCH_TAC ``(x:real) IN interval[a,b]`` THEN
        ASM_SIMP_TAC std_ss [INTERVAL_SING, IN_SING, REAL_SUB_REFL, ABS_0] THEN
        REAL_ARITH_TAC,
        UNDISCH_TAC ``f continuous_on interval [(a,b)]`` THEN DISCH_TAC THEN
        FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [continuous_on]) THEN
        DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[dist] THEN
        DISCH_THEN(MP_TAC o SPEC
         ``e / &2 pow (4 + n(x:real)) * abs(b - a:real)``) THEN
        ASM_SIMP_TAC std_ss [REAL_LT_DIV, REAL_LT_MUL, GSYM ABS_NZ, REAL_SUB_0,
                     REAL_LT_POW2, REAL_LT_IMP_NE] THEN
        MESON_TAC[REAL_LT_IMP_LE]],
      FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN
      ASM_SIMP_TAC std_ss [IN_DIFF, has_vector_derivative,
                      HAS_DERIVATIVE_WITHIN_ALT] THEN
      DISCH_THEN(MP_TAC o SPEC ``e / &2:real`` o CONJUNCT2) THEN
      ASM_REWRITE_TAC[REAL_HALF] THEN MESON_TAC[]],
    DISCH_TAC THEN POP_ASSUM (MP_TAC o SIMP_RULE std_ss [RIGHT_IMP_EXISTS_THM]) THEN
    SIMP_TAC std_ss [SKOLEM_THM, LEFT_IMP_EXISTS_THM, FORALL_AND_THM, AND_IMP_INTRO,
                TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN
    X_GEN_TAC ``d:real->real`` THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)] THEN
  EXISTS_TAC ``\x. ball(x:real,d(x))`` THEN
  ASM_SIMP_TAC std_ss [GAUGE_BALL_DEPENDENT] THEN
  X_GEN_TAC ``p:(real#(real->bool))->bool`` THEN STRIP_TAC THEN
  MP_TAC(ISPECL [``f:real->real``, ``p:(real#(real->bool))->bool``,
                 ``a:real``, ``b:real``]
                ADDITIVE_TAGGED_DIVISION_1) THEN
  ASM_SIMP_TAC std_ss [CONTENT_CLOSED_INTERVAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
  UNDISCH_TAC ``p tagged_division_of interval [(a,b)]`` THEN DISCH_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
  ASM_SIMP_TAC std_ss [GSYM SUM_SUB, LAMBDA_PROD] THEN
  SUBGOAL_THEN
   ``p:(real#(real->bool))->bool =
    {(x,k) | (x,k) IN p /\ x IN IMAGE r (t:num->bool)} UNION
    {(x,k) | (x,k) IN p /\ ~(x IN IMAGE r (t:num->bool))}``
  SUBST1_TAC THENL
   [SIMP_TAC std_ss [EXTENSION, FORALL_PROD, IN_ELIM_PAIR_THM, IN_UNION] THEN
    MESON_TAC[],
    ALL_TAC] THEN
  W(MP_TAC o PART_MATCH (lhs o rand) SUM_UNION o rand o lhand o snd) THEN
  KNOW_TAC ``FINITE
       {(x,k) |
        (x,k) IN (p :real # (real -> bool) -> bool) /\
        x IN IMAGE (r :num -> real) (t :num -> bool)} /\
     FINITE {(x,k) | (x,k) IN p /\ x NOTIN IMAGE r t} /\
     DISJOINT {(x,k) | (x,k) IN p /\ x IN IMAGE r t}
       {(x,k) | (x,k) IN p /\ x NOTIN IMAGE r t}`` THENL
   [REWRITE_TAC[SET_RULE ``DISJOINT s t <=> !x. x IN s ==> ~(x IN t)``] THEN
    SIMP_TAC std_ss [FORALL_IN_GSPEC, IN_ELIM_PAIR_THM] THEN CONJ_TAC THEN
    MATCH_MP_TAC FINITE_SUBSET THEN
    EXISTS_TAC ``p:(real#(real->bool))->bool`` THEN
    ASM_SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_GSPEC, IN_ELIM_PAIR_THM],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    DISCH_THEN SUBST1_TAC] THEN
  SUBGOAL_THEN
   ``(!P. FINITE {(x:real,k:real->bool) | (x,k) IN p /\ P x k}) /\
     (!P x. FINITE {(x:real,k:real->bool) |k| (x,k) IN p /\ P x k})``
  STRIP_ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN
    EXISTS_TAC ``p:real#(real->bool)->bool`` THEN
    ASM_SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_GSPEC],
    ALL_TAC] THEN
  KNOW_TAC ``!x y e a. abs(x:real) <= e / &2 * a /\ abs(y) <= e / &2 * a
             ==> abs(x + y) <= e * a`` THENL
 [REPEAT GEN_TAC THEN REWRITE_TAC [real_div] THEN
  ONCE_REWRITE_TAC [REAL_ARITH ``a * b * c = (a * c) * b:real``] THEN
  REWRITE_TAC [GSYM real_div] THEN
  SIMP_TAC std_ss [REAL_LE_RDIV_EQ, REAL_ARITH ``0 < &2:real``] THEN
  REAL_ARITH_TAC, DISCH_TAC] THEN
  FIRST_X_ASSUM (MATCH_MP_TAC) THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
     ``abs(sum {(x,k) | (x,k) IN p /\ x IN IMAGE (r:num->real) t /\
                         ~(content k = &0)}
                (\(x,k). -(f(interval_upperbound k) -
                            (f:real->real)(interval_lowerbound k))))`` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN
      MATCH_MP_TAC SUM_EQ_SUPERSET THEN
      ASM_SIMP_TAC std_ss [FORALL_IN_GSPEC, IMP_CONJ] THEN
      CONJ_TAC THENL [SIMP_TAC std_ss [LAMBDA_PAIR] THEN SET_TAC[], ALL_TAC] THEN
      SIMP_TAC std_ss [REAL_ARITH ``a * 0 - x:real = -x``] THEN
      SIMP_TAC std_ss [IN_ELIM_PAIR_THM] THEN
      MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN DISCH_TAC THEN
      SUBGOAL_THEN ``?u v:real. (k = interval[u,v]) /\ x IN interval[u,v]``
      STRIP_ASSUME_TAC THENL
       [ASM_MESON_TAC[TAGGED_DIVISION_OF], ALL_TAC] THEN
      ASM_REWRITE_TAC[CONTENT_EQ_0] THEN
      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [IN_INTERVAL]) THEN
      DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_TRANS) THEN
      SIMP_TAC std_ss [INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND,
               GSYM INTERVAL_EQ_EMPTY, REAL_NOT_LE, REAL_NOT_LT] THEN
      REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
       ``(x:real = y) ==> (-(x - y) = 0)``) THEN
      AP_TERM_TAC THEN ASM_SIMP_TAC std_ss [GSYM REAL_LE_ANTISYM],
      ALL_TAC] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
     ``sum {(x,k:real->bool) | (x,k) IN p /\ x IN IMAGE (r:num->real) t /\
                                ~(content k = &0)}
          ((\(x,k). e / &2 pow (3 + n x) * abs (b - a:real)))`` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC SUM_ABS_LE THEN
      ASM_SIMP_TAC std_ss [FORALL_IN_GSPEC, IMP_CONJ] THEN
      MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN DISCH_TAC THEN
      SUBGOAL_THEN ``?u v:real. (k = interval[u,v]) /\ x IN interval[u,v]``
      MP_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF], ALL_TAC] THEN
      DISCH_THEN(REPEAT_TCL CHOOSE_THEN
        (CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC)) THEN
      SIMP_TAC std_ss [CONTENT_EQ_0, REAL_NOT_LE, REAL_LT_IMP_LE, IN_INTERVAL,
               INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND] THEN
      REPEAT STRIP_TAC THEN
      UNDISCH_TAC ``!(x :real).
            x IN interval [((a :real),(b :real))] /\
            x IN IMAGE (r :num -> real) (t :num -> bool) ==>
            !(y :real).
              abs (y - x) < (d :real -> real) x /\ y IN interval [(a,b)] ==>
              abs ((f :real -> real) y - f x) <=
              (e :real) / (2 :real) pow ((4 :num) + (n :real -> num) x) *
              abs (b - a)`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM (MP_TAC o SPEC ``x:real``) THEN
      KNOW_TAC ``(x :real) IN interval [((a :real),(b :real))] /\
                  x IN IMAGE (r :num -> real) (t :num -> bool)`` THENL
       [ASM_MESON_TAC[TAGGED_DIVISION_OF, SUBSET_DEF],
        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
      DISCH_THEN(fn th =>
        MP_TAC(ISPEC ``u:real`` th) THEN MP_TAC(ISPEC ``v:real`` th)) THEN
      UNDISCH_TAC ``(\x. ball (x,d x)) FINE p`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [FINE]) THEN BETA_TAC THEN
      DISCH_THEN(MP_TAC o SPECL [``x:real``, ``interval[u:real,v]``]) THEN
      ASM_REWRITE_TAC[SUBSET_DEF, IN_BALL] THEN
      DISCH_THEN(fn th =>
        MP_TAC(ISPEC ``u:real`` th) THEN MP_TAC(ISPEC ``v:real`` th)) THEN
      ASM_REWRITE_TAC[dist, ENDS_IN_INTERVAL, INTERVAL_NE_EMPTY] THEN
      ASM_SIMP_TAC std_ss [REAL_LT_IMP_LE, ABS_SUB] THEN DISCH_TAC THEN DISCH_TAC THEN
      SUBGOAL_THEN ``interval[u:real,v] SUBSET interval[a,b]`` ASSUME_TAC THENL
       [ASM_MESON_TAC[TAGGED_DIVISION_OF], ALL_TAC] THEN
      KNOW_TAC ``v IN interval [(a,b)]`` THENL
      [ASM_MESON_TAC[ENDS_IN_INTERVAL, SUBSET_DEF, INTERVAL_NE_EMPTY,
                      REAL_LT_IMP_LE],
       DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
        ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`]] THEN
      KNOW_TAC ``u IN interval [(a,b)]`` THENL
      [ASM_MESON_TAC[ENDS_IN_INTERVAL, SUBSET_DEF, INTERVAL_NE_EMPTY,
                      REAL_LT_IMP_LE],
       DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
        ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`]] THEN
      SIMP_TAC std_ss [REAL_POW_ADD, real_div, REAL_INV_MUL] THEN
      ONCE_REWRITE_TAC [REAL_ARITH ``a * b * c = (a * c) * b:real``] THEN
      REWRITE_TAC [GSYM real_div] THEN
      SIMP_TAC std_ss [REAL_LE_RDIV_EQ,
       METIS [REAL_LT_MUL, REAL_LT_POW2] ``0:real < (2 pow 3 * 2 pow n x)``,
       METIS [REAL_LT_MUL, REAL_LT_POW2] ``0:real < (2 pow 4 * 2 pow n x)``] THEN
      ONCE_REWRITE_TAC [ARITH_PROVE ``4 = SUC 3``] THEN ONCE_REWRITE_TAC [pow] THEN
      ONCE_REWRITE_TAC [REAL_ARITH ``a * (b * c * d) = (a * c * d) * b:real``] THEN
      SIMP_TAC std_ss [GSYM REAL_LE_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
      GEN_REWR_TAC (RAND_CONV o RAND_CONV o RAND_CONV) [GSYM REAL_HALF] THEN
      DISCH_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
      EXISTS_TAC `` abs ((f :real -> real) (v :real) - f (x :real)) *
           (2 :real) pow (3 :num) * (2 :real) pow (n :real -> num) x +
                   abs ((f :real -> real) (u :real) - f (x :real)) *
           (2 :real) pow (3 :num) * (2 :real) pow (n :real -> num) x`` THEN
      CONJ_TAC THENL [ALL_TAC, MATCH_MP_TAC REAL_LE_ADD2] THEN
          ASM_REWRITE_TAC [] THEN
      REWRITE_TAC [GSYM REAL_ADD_RDISTRIB] THEN REWRITE_TAC [REAL_MUL_ASSOC] THEN
      MATCH_MP_TAC REAL_LE_RMUL_IMP THEN
          SIMP_TAC std_ss [REAL_LE_LT, REAL_LT_POW2] THEN
      REWRITE_TAC [GSYM REAL_LE_LT] THEN MATCH_MP_TAC REAL_LE_RMUL_IMP THEN
      SIMP_TAC std_ss [REAL_LE_LT, REAL_LT_POW2] THEN
          REWRITE_TAC [GSYM REAL_LE_LT] THEN
      REAL_ARITH_TAC, ALL_TAC] THEN
    MP_TAC(ISPECL
     [``FST:real#(real->bool)->real``,
      ``\(x:real,k:real->bool). e / &2 pow (3 + n x) * abs (b - a:real)``,
      ``{(x:real,k:real->bool) | (x,k) IN p /\ x IN IMAGE (r:num->real) t /\
                                ~(content k = &0)}``,
      ``IMAGE (r:num->real) t``] SUM_GROUP) THEN
    KNOW_TAC ``FINITE
       {(x,k) |
        (x,k) IN (p :real # (real -> bool) -> bool) /\
        x IN IMAGE (r :num -> real) (t :num -> bool) /\
        content k <> (0 :real)} /\
     IMAGE (FST :real # (real -> bool) -> real)
       {(x,k) |
        (x,k) IN p /\ x IN IMAGE r t /\ content k <> (0 :real)} SUBSET
     IMAGE r t`` THENL
     [ASM_SIMP_TAC std_ss [] THEN
      SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_IMAGE, FORALL_IN_GSPEC],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
      DISCH_THEN(SUBST1_TAC o SYM)] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
     ``sum (IMAGE (r:num->real) t)
          (\x. sum {(x,k:real->bool) |k|
                    (x,k) IN p /\ ~(content k = &0)}
                   (\yk. e / &2 pow (3 + n x) * abs(b - a:real)))`` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN
      X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN SIMP_TAC std_ss [] THEN
      MATCH_MP_TAC SUM_EQ_SUPERSET THEN
      ASM_SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_GSPEC, IMP_CONJ] THEN
      SIMP_TAC std_ss [GSPECIFICATION, PAIR_EQ, LAMBDA_PAIR] THEN METIS_TAC[],
      ALL_TAC] THEN
    ASM_SIMP_TAC std_ss [SUM_CONST] THEN REWRITE_TAC [REAL_MUL_ASSOC] THEN
    SIMP_TAC std_ss [SUM_RMUL] THEN
    ASM_SIMP_TAC std_ss [abs, REAL_SUB_LE] THEN MATCH_MP_TAC REAL_LE_RMUL_IMP THEN
    ASM_SIMP_TAC std_ss [REAL_SUB_LE, REAL_POW_ADD, real_div, REAL_INV_MUL,
                         REAL_LT_POW2, REAL_LT_IMP_NE, REAL_MUL_ASSOC] THEN
    KNOW_TAC ``!p e n. p * e * inv(&2 pow 3) * n = e / &8 * (p * n):real`` THENL
    [REPEAT GEN_TAC THEN REWRITE_TAC [real_div, REAL_MUL_ASSOC] THEN
     ONCE_REWRITE_TAC [REAL_ARITH ``a * b * c * d = (a * c * d) * b:real``] THEN
     REWRITE_TAC [GSYM real_div] THEN
         SIMP_TAC std_ss [REAL_EQ_RDIV_EQ, REAL_ARITH ``0 < 8:real``] THEN
     REWRITE_TAC [real_div, REAL_MUL_ASSOC] THEN
     ONCE_REWRITE_TAC [REAL_ARITH
          ``a * b * c * d * e = (a * c * d * e) * b:real``] THEN
     REWRITE_TAC [GSYM real_div] THEN
         SIMP_TAC std_ss [REAL_EQ_LDIV_EQ, REAL_LT_POW2] THEN
     REWRITE_TAC [ARITH_PROVE ``3 = SUC 2``, pow, POW_2] THEN REAL_ARITH_TAC,
     DISCH_TAC THEN ONCE_ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
     KNOW_TAC ``!e x. e / &8 * x <= e * inv(&2) <=> e * x <= e * &4:real`` THENL
     [REPEAT GEN_TAC THEN REWRITE_TAC [GSYM real_div] THEN
      SIMP_TAC std_ss [REAL_LE_RDIV_EQ, REAL_ARITH ``0 < 2:real``] THEN
      ONCE_REWRITE_TAC [REAL_ARITH ``a * b * c = b * c * a:real``] THEN
      REWRITE_TAC [real_div, REAL_MUL_ASSOC] THEN REWRITE_TAC [GSYM real_div] THEN
      SIMP_TAC std_ss [REAL_LE_LDIV_EQ, REAL_ARITH ``0 < 8:real``] THEN
          REAL_ARITH_TAC,
      DISCH_TAC THEN ASM_SIMP_TAC std_ss [REAL_LE_LMUL, SUM_LMUL] THEN
      POP_ASSUM K_TAC] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
     ``sum (IMAGE (r:num->real) t INTER
           IMAGE (FST:real#(real->bool)->real) p)
          (\x. &(CARD {(x,k:real->bool) | k |
                      (x,k) IN p /\ ~(content k = &0)}) *
               inv(&2 pow n x))`` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_SUPERSET THEN
      SIMP_TAC std_ss [INTER_SUBSET, IMP_CONJ, FORALL_IN_IMAGE] THEN
      SIMP_TAC std_ss [IN_INTER, FUN_IN_IMAGE] THEN
      SIMP_TAC std_ss [IN_IMAGE, EXISTS_PROD] THEN
      REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ENTIRE] THEN
      DISJ1_TAC THEN AP_TERM_TAC THEN
      MATCH_MP_TAC(METIS [CARD_EMPTY, CARD_INSERT] ``(s = {}) ==> (CARD s = 0)``) THEN
      ASM_SET_TAC[], ALL_TAC] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
     ``sum (IMAGE (r:num->real) t INTER
           IMAGE (FST:real#(real->bool)->real) p)
          (\x. &2 / &2 pow (n x))`` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC SUM_LE THEN
      ASM_SIMP_TAC std_ss [IMAGE_FINITE, FINITE_INTER] THEN
      GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_div] THEN
      MATCH_MP_TAC REAL_LE_RMUL_IMP THEN
      SIMP_TAC std_ss [REAL_LE_INV_EQ, POW_POS, REAL_POS, REAL_OF_NUM_LE] THEN
      GEN_REWR_TAC RAND_CONV [GSYM EXP_1] THEN
      MATCH_MP_TAC TAGGED_PARTIAL_DIVISION_COMMON_TAGS THEN
      ASM_MESON_TAC[tagged_division_of],
      ALL_TAC] THEN
    SIMP_TAC std_ss [real_div, SUM_LMUL, REAL_ARITH ``&2 * x <= &4 <=> x <= &2:real``,
                POW_INV, REAL_ARITH ``2 <> 0:real``] THEN
    SUBGOAL_THEN
     ``(\x:real. inv (&2) pow n x) = (\n. inv(&2:real) pow n) o n``
    SUBST1_TAC THENL [SIMP_TAC std_ss [o_DEF], ALL_TAC] THEN
    W(MP_TAC o PART_MATCH (rand o rand) SUM_IMAGE o lhand o snd) THEN
    KNOW_TAC ``(!(x :real) (y :real).
        x IN
        IMAGE (r :num -> real) (t :num -> bool) INTER
        IMAGE (FST :real # (real -> bool) -> real)
          (p :real # (real -> bool) -> bool) /\
        y IN IMAGE r t INTER IMAGE (FST :real # (real -> bool) -> real) p /\
        ((n :real -> num) x = n y) ==>
        (x = y))`` THENL
    [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
     POP_ASSUM K_TAC THEN DISCH_THEN(SUBST1_TAC o SYM)] THEN
    SUBGOAL_THEN
     ``?m. IMAGE (n:real->num)
                (IMAGE (r:num->real) t INTER
                IMAGE (FST:real#(real->bool)->real) p) SUBSET ((0:num)..m)``
    STRIP_ASSUME_TAC THENL
     [REWRITE_TAC[SUBSET_DEF, IN_NUMSEG, LE_0] THEN
      GEN_REWR_TAC (QUANT_CONV o QUANT_CONV o RAND_CONV o LAND_CONV)
           [METIS [] ``x = (\x. x) x``] THEN
      MATCH_MP_TAC UPPER_BOUND_FINITE_SET THEN
      ASM_SIMP_TAC std_ss [IMAGE_FINITE, FINITE_INTER],
      ALL_TAC] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC ``sum((0:num)..m) (\n. inv(&2) pow n)`` THEN CONJ_TAC THENL
     [MATCH_MP_TAC SUM_SUBSET THEN
      ASM_SIMP_TAC std_ss [IMAGE_FINITE, FINITE_INTER, FINITE_NUMSEG] THEN
      SIMP_TAC std_ss [REAL_LE_INV_EQ, POW_POS, REAL_POS] THEN ASM_SET_TAC[],
      SIMP_TAC std_ss [SUM_GP, LT, SUB_0] THEN
      SIMP_TAC std_ss [METIS [REAL_ARITH ``1 <> 2:real``, REAL_INV_1OVER,
          REAL_EQ_LDIV_EQ,  REAL_ARITH ``0 < 2:real``, REAL_MUL_LID]
           ``inv 2 <> 1:real``, pow, REAL_INV_1OVER] THEN
      SIMP_TAC std_ss [METIS [REAL_HALF_DOUBLE, REAL_EQ_SUB_RADD]
          ``1 - 1 / 2 = 1 / 2:real``] THEN
      SIMP_TAC std_ss [GSYM pow] THEN
      KNOW_TAC ``!x. (&1 - x) / (&1 / &2) <= &2 <=> &0 <= x:real`` THENL
      [REPEAT GEN_TAC THEN REWRITE_TAC [real_div, REAL_MUL_ASSOC,
           REAL_MUL_LID, REAL_INV_INV] THEN
       REAL_ARITH_TAC, DISCH_TAC] THEN
      ASM_REWRITE_TAC [] THEN MATCH_MP_TAC POW_POS THEN
      SIMP_TAC std_ss [REAL_LE_RDIV_EQ, REAL_ARITH ``0 < 2:real``, REAL_MUL_LZERO,
                       REAL_ARITH ``0 <= 1:real``]],
    MP_TAC(ISPECL [``\x:real. x``, ``p:(real#(real->bool))->bool``,
                   ``a:real``, ``b:real``] ADDITIVE_TAGGED_DIVISION_1) THEN
    ASM_SIMP_TAC std_ss [] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
    REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC
     ``sum {(x:real,k:real->bool) |
           (x,k) IN p /\ ~(x IN IMAGE r (t:num->bool))}
          (\x. e / &2 *
            (\(x,k). interval_upperbound k - interval_lowerbound k) x)`` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC SUM_ABS_LE THEN ASM_SIMP_TAC std_ss [FORALL_IN_GSPEC] THEN
      SIMP_TAC std_ss [o_DEF] THEN
      REWRITE_TAC[REAL_ARITH ``abs(a - (b - c):real) = abs(b - c - a)``] THEN
      MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN STRIP_TAC THEN
      SUBGOAL_THEN ``?u v:real. (k = interval[u,v]) /\ x IN interval[u,v]``
      MP_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF], ALL_TAC] THEN
      DISCH_THEN(REPEAT_TCL CHOOSE_THEN
       (CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC)) THEN
      REWRITE_TAC[IN_INTERVAL] THEN DISCH_THEN(fn th =>
        ASSUME_TAC th THEN MP_TAC(MATCH_MP REAL_LE_TRANS th)) THEN
      ASM_SIMP_TAC std_ss [CONTENT_CLOSED_INTERVAL,
       INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND] THEN
      DISCH_TAC THEN
      UNDISCH_TAC `` !(x :real).
            x IN interval [((a :real),(b :real))] /\
            x NOTIN IMAGE (r :num -> real) (t :num -> bool) ==>
            !(y :real).
              abs (y - x) < (d :real -> real) x /\ y IN interval [(a,b)] ==>
              abs
                ((f :real -> real) y - f x -
                 (y - x) * (f' :real -> real) x) <=
              (e :real) / (2 :real) * abs (y - x)`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM (MP_TAC o SPEC ``x:real``) THEN
      ASM_REWRITE_TAC[] THEN
      SUBGOAL_THEN ``interval[u:real,v] SUBSET interval[a,b]`` ASSUME_TAC THENL
       [ASM_MESON_TAC[TAGGED_DIVISION_OF], ALL_TAC] THEN
      KNOW_TAC ``x IN interval [(a,b)]`` THENL
      [ASM_MESON_TAC[SUBSET_DEF, IN_INTERVAL],
       DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
      DISCH_THEN(fn th =>
        MP_TAC(ISPEC ``u:real`` th) THEN MP_TAC(ISPEC ``v:real`` th)) THEN
      UNDISCH_TAC ``(\x. ball (x,d x)) FINE p`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [FINE]) THEN
      DISCH_THEN(MP_TAC o SPECL [``x:real``, ``interval[u:real,v]``]) THEN
      ASM_SIMP_TAC std_ss [SUBSET_DEF, IN_BALL] THEN
      DISCH_THEN(fn th =>
        MP_TAC(ISPEC ``u:real`` th) THEN MP_TAC(ISPEC ``v:real`` th)) THEN
      ASM_SIMP_TAC std_ss [dist, ENDS_IN_INTERVAL, INTERVAL_NE_EMPTY] THEN
      ASM_SIMP_TAC std_ss [REAL_LT_IMP_LE, ABS_SUB] THEN DISCH_TAC THEN DISCH_TAC THEN
      KNOW_TAC ``v IN interval [(a,b)]`` THENL
      [ASM_MESON_TAC[ENDS_IN_INTERVAL, SUBSET_DEF, INTERVAL_NE_EMPTY,
                      REAL_LT_IMP_LE],
        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
        ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`]] THEN
      KNOW_TAC ``u IN interval [(a,b)]`` THENL
      [ASM_MESON_TAC[ENDS_IN_INTERVAL, SUBSET_DEF, INTERVAL_NE_EMPTY,
                      REAL_LT_IMP_LE],
        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
        ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`]] THEN
      ASM_SIMP_TAC std_ss [REAL_ARITH ``a <= b ==> (abs(a - b) = b - a:real)``,
                           REAL_ARITH ``b <= a ==> (abs(a - b) = a - b:real)``] THEN
      REWRITE_TAC[REAL_SUB_LDISTRIB] THEN MATCH_MP_TAC(REAL_ARITH
       ``(x - y:real = z) ==> abs(x) <= c - b
                   ==> abs(y) <= b - a ==> abs(z) <= c - a``) THEN
      REAL_ARITH_TAC,
      MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_REWRITE_TAC[] THEN
      CONJ_TAC THENL [SIMP_TAC std_ss [LAMBDA_PAIR] THEN ASM_SET_TAC[],
                      SIMP_TAC std_ss [FORALL_PROD]] THEN
      SIMP_TAC std_ss [IN_DIFF, IN_ELIM_PAIR_THM] THEN
      MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN STRIP_TAC THEN
      SUBGOAL_THEN ``?u v:real. (k = interval[u,v]) /\ x IN interval[u,v]``
      MP_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF], ALL_TAC] THEN
      DISCH_THEN(REPEAT_TCL CHOOSE_THEN
       (CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC)) THEN
      REWRITE_TAC[IN_INTERVAL, o_THM] THEN
      DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_TRANS) THEN
      SIMP_TAC std_ss [INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND] THEN
      REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN
      CONJ_TAC THENL [REWRITE_TAC [REAL_LE_LT] THEN
      ASM_SIMP_TAC std_ss [REAL_HALF], ALL_TAC] THEN
      POP_ASSUM MP_TAC THEN REAL_ARITH_TAC]]);

val FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG = store_thm ("FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG",
 ``!f:real->real f' s a b.
        COUNTABLE s /\
        a <= b /\ f continuous_on interval[a,b] /\
        (!x. x IN interval(a,b) DIFF s
             ==> (f has_vector_derivative f'(x)) (at x))
        ==> (f' has_integral (f(b) - f(a))) (interval[a,b])``,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG THEN
  EXISTS_TAC ``(a:real) INSERT (b:real) INSERT s`` THEN
  ASM_REWRITE_TAC[COUNTABLE_INSERT, IN_INTERVAL, IN_DIFF] THEN
  REWRITE_TAC[DE_MORGAN_THM, IN_INSERT] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_REWRITE_TAC[IN_INTERVAL, IN_DIFF, IN_INSERT] THEN
  METIS_TAC[REAL_LT_LE]);

val FUNDAMENTAL_THEOREM_OF_CALCULUS = store_thm ("FUNDAMENTAL_THEOREM_OF_CALCULUS",
 ``!f:real->real f' a b.
        a <= b /\
        (!x. x IN interval[a,b]
             ==> (f has_vector_derivative f'(x)) (at x within interval[a,b]))
        ==> (f' has_integral (f(b) - f(a))) (interval[a,b])``,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG THEN
  EXISTS_TAC ``{}:real->bool`` THEN
  ASM_REWRITE_TAC[COUNTABLE_EMPTY, DIFF_EMPTY] THEN
  MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN
  REWRITE_TAC[differentiable_on] THEN
  METIS_TAC[has_vector_derivative, differentiable]);

val FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR = store_thm ("FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR",
 ``!f:real->real f' a b.
        a <= b /\ f continuous_on interval[a,b] /\
        (!x. x IN interval(a,b)
             ==> (f has_vector_derivative f'(x)) (at x))
        ==> (f' has_integral (f(b) - f(a))) (interval[a,b])``,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG THEN
  EXISTS_TAC ``{}:real->bool`` THEN
  ASM_REWRITE_TAC[COUNTABLE_EMPTY, DIFF_EMPTY]);

val ANTIDERIVATIVE_INTEGRAL_CONTINUOUS = store_thm ("ANTIDERIVATIVE_INTEGRAL_CONTINUOUS",
 ``!f:real->real a b.
     (f continuous_on interval[a,b])
     ==> ?g. !u v. u IN interval[a,b] /\ v IN interval[a,b] /\ u <= v
                   ==> (f has_integral (g(v) - g(u))) (interval[u,v])``,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP ANTIDERIVATIVE_CONTINUOUS) THEN
  STRIP_TAC THEN EXISTS_TAC ``g:real->real`` THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS THEN
  ASM_REWRITE_TAC[] THEN X_GEN_TAC ``x:real`` THEN
  STRIP_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET THEN
  EXISTS_TAC ``interval[a:real,b]`` THEN CONJ_TAC THENL
   [FIRST_X_ASSUM MATCH_MP_TAC, ALL_TAC] THEN
  REPEAT(POP_ASSUM MP_TAC) THEN
  REWRITE_TAC[SUBSET_INTERVAL, IN_INTERVAL] THENL
  [REAL_ARITH_TAC, METIS_TAC [REAL_LE_TRANS]]);

(* ------------------------------------------------------------------------- *)
(* This doesn't directly involve integration, but that gives an easy proof.  *)
(* ------------------------------------------------------------------------- *)

val HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL = store_thm ("HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL",
 ``!f:real->real a b k y.
        COUNTABLE k /\ f continuous_on interval[a,b] /\ (f a = y) /\
        (!x. x IN (interval[a,b] DIFF k)
             ==> (f has_derivative (\h. 0)) (at x within interval[a,b]))
        ==> !x. x IN interval[a,b] ==> (f x = y)``,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
  MATCH_MP_TAC(ISPEC ``(\x. 0):real->real`` HAS_INTEGRAL_UNIQUE) THEN
  EXISTS_TAC ``interval[a:real,x]`` THEN
  REWRITE_TAC[HAS_INTEGRAL_0] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
  MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG THEN
  EXISTS_TAC ``k:real->bool`` THEN ASM_SIMP_TAC std_ss [] THEN REPEAT CONJ_TAC THENL
   [REPEAT(FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [IN_INTERVAL])) THEN
    SIMP_TAC std_ss [],
    MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
    EXISTS_TAC ``interval[a:real,b]`` THEN
    ASM_REWRITE_TAC[SUBSET_INTERVAL] THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [IN_INTERVAL])) THEN
    SIMP_TAC std_ss [REAL_LE_REFL],
    X_GEN_TAC ``y:real`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``y:real``) THEN
    KNOW_TAC ``y IN interval [(a,b)] DIFF k`` THENL
     [REPEAT(POP_ASSUM MP_TAC) THEN
      SIMP_TAC std_ss [IN_DIFF, IN_INTERVAL] THEN REAL_ARITH_TAC,
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
      HAS_DERIVATIVE_WITHIN_SUBSET)) THEN
    DISCH_THEN(MP_TAC o SPEC ``interval(a:real,b)``) THEN
    REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED] THEN
    REWRITE_TAC[has_vector_derivative, REAL_MUL_RZERO] THEN
    MATCH_MP_TAC EQ_IMPLIES THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_OPEN THEN
    REPEAT(POP_ASSUM MP_TAC) THEN
    SIMP_TAC std_ss [OPEN_INTERVAL, IN_INTERVAL, IN_DIFF] THEN REAL_ARITH_TAC]);

(* ------------------------------------------------------------------------- *)
(* Integration by parts.                                                     *)
(* ------------------------------------------------------------------------- *)

val INTEGRATION_BY_PARTS = store_thm ("INTEGRATION_BY_PARTS",
 ``!(bop:real->real->real) f g f' g' a b c y.
        bilinear bop /\ a <= b /\ COUNTABLE c /\
        (\x. bop (f x) (g x)) continuous_on interval[a,b] /\
        (!x. x IN interval(a,b) DIFF c
             ==> (f has_vector_derivative f'(x)) (at x) /\
                 (g has_vector_derivative g'(x)) (at x)) /\
        ((\x. bop (f x) (g' x)) has_integral
         ((bop (f b) (g b) - bop (f a) (g a)) - y))
            (interval[a,b])
        ==> ((\x. bop (f' x) (g x)) has_integral y) (interval[a,b])``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [``\x:real. (bop:real->real->real) (f x) (g x)``,
                 ``\x:real. (bop:real->real->real) (f x) (g' x) +
                             (bop:real->real->real) (f' x) (g x)``,
                 ``c:real->bool``, ``a:real``, ``b:real``]
    FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG) THEN
  ASM_SIMP_TAC std_ss [HAS_VECTOR_DERIVATIVE_BILINEAR_AT] THEN
  FIRST_ASSUM(fn th => MP_TAC th THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
        DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB)) THEN
  SIMP_TAC std_ss [REAL_ARITH ``b - a - (b - a - y):real = y``, REAL_ADD_SUB]);

val INTEGRATION_BY_PARTS_SIMPLE = store_thm ("INTEGRATION_BY_PARTS_SIMPLE",
 ``!(bop:real->real->real) f g f' g' a b y.
        bilinear bop /\ a <= b /\
        (!x. x IN interval[a,b]
             ==> (f has_vector_derivative f'(x)) (at x within interval[a,b]) /\
                 (g has_vector_derivative g'(x)) (at x within interval[a,b])) /\
        ((\x. bop (f x) (g' x)) has_integral
         ((bop (f b) (g b) - bop (f a) (g a)) - y))
            (interval[a,b])
        ==> ((\x. bop (f' x) (g x)) has_integral y) (interval[a,b])``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [``\x:real. (bop:real->real->real) (f x) (g x)``,
                 ``\x:real. (bop:real->real->real) (f x) (g' x) +
                             (bop:real->real->real) (f' x) (g x)``,
                 ``a:real``, ``b:real``]
    FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN
  ASM_SIMP_TAC std_ss [HAS_VECTOR_DERIVATIVE_BILINEAR_WITHIN] THEN
  FIRST_ASSUM(fn th => MP_TAC th THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
        DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB)) THEN
  SIMP_TAC std_ss [REAL_ARITH ``b - a - (b - a - y):real = y``, REAL_ADD_SUB]);

val INTEGRABLE_BY_PARTS = store_thm ("INTEGRABLE_BY_PARTS",
 ``!(bop:real->real->real) f g f' g' a b c.
        bilinear bop /\ COUNTABLE c /\
        (\x. bop (f x) (g x)) continuous_on interval[a,b] /\
        (!x. x IN interval(a,b) DIFF c
             ==> (f has_vector_derivative f'(x)) (at x) /\
                 (g has_vector_derivative g'(x)) (at x)) /\
        (\x. bop (f x) (g' x)) integrable_on interval[a,b]
        ==> (\x. bop (f' x) (g x)) integrable_on interval[a,b]``,
  REPEAT GEN_TAC THEN
  DISJ_CASES_TAC(REAL_ARITH ``b <= a \/ a <= b:real``) THENL
   [DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC INTEGRABLE_ON_NULL THEN
    ASM_REWRITE_TAC[CONTENT_EQ_0],
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    REWRITE_TAC[integrable_on] THEN
    DISCH_THEN(X_CHOOSE_THEN ``y:real`` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC ``(bop ((f:real->real) b) ((g:real->real) b) -
                 bop (f a) (g a)) - (y:real)`` THEN
    MATCH_MP_TAC INTEGRATION_BY_PARTS THEN MAP_EVERY EXISTS_TAC
     [``f:real->real``, ``g':real->real``, ``c:real->bool``] THEN
    ASM_REWRITE_TAC[REAL_ARITH ``b - a - ((b - a) - y):real = y``]]);

val INTEGRABLE_BY_PARTS_EQ = store_thm ("INTEGRABLE_BY_PARTS_EQ",
 ``!(bop:real->real->real) f g f' g' a b c.
        bilinear bop /\ COUNTABLE c /\
        (\x. bop (f x) (g x)) continuous_on interval[a,b] /\
        (!x. x IN interval(a,b) DIFF c
             ==> (f has_vector_derivative f'(x)) (at x) /\
                 (g has_vector_derivative g'(x)) (at x))
        ==> ((\x. bop (f x) (g' x)) integrable_on interval[a,b] <=>
             (\x. bop (f' x) (g x)) integrable_on interval[a,b])``,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [METIS_TAC[INTEGRABLE_BY_PARTS], DISCH_TAC] THEN
  MP_TAC(ISPEC ``\x y. (bop:real->real->real) y x``
        INTEGRABLE_BY_PARTS) THEN
  SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
  KNOW_TAC ``bilinear (\(x :real) (y :real). (bop :real -> real -> real) y x)`` THENL
  [ALL_TAC, METIS_TAC[]] THEN
  UNDISCH_TAC ``bilinear(bop:real->real->real)`` THEN
  REWRITE_TAC[bilinear] THEN METIS_TAC[]);

(* ------------------------------------------------------------------------- *)
(* Equiintegrability. The definition here only really makes sense for an     *)
(* elementary set. We just use compact intervals in applications below.      *)
(* ------------------------------------------------------------------------- *)

val _ = set_fixity "equiintegrable_on" (Infix(NONASSOC, 450));

val equiintegrable_on = new_definition ("equiintegrable_on",
  ``fs equiintegrable_on i <=>
        (!f:real->real. f IN fs ==> f integrable_on i) /\
        (!e. &0 < e
             ==> ?d. gauge d /\
                    !f p. f IN fs /\ p tagged_division_of i /\ d FINE p
                        ==> abs(sum p (\(x,k). content(k) * f(x)) -
                                 integral i f) < e)``);

val EQUIINTEGRABLE_ON_SING = store_thm ("EQUIINTEGRABLE_ON_SING",
 ``!f:real->real a b.
        {f} equiintegrable_on interval[a,b] <=>
        f integrable_on interval[a,b]``,
  REPEAT GEN_TAC THEN REWRITE_TAC[equiintegrable_on] THEN
  SIMP_TAC std_ss [IN_SING, UNWIND_FORALL_THM2] THEN
  ASM_CASES_TAC ``(f:real->real) integrable_on interval[a,b]`` THEN
  ASM_SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM, UNWIND_FORALL_THM2] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN
  REWRITE_TAC[has_integral, AND_IMP_INTRO]);

(* ------------------------------------------------------------------------- *)
(* Basic combining theorems for the interval of integration.                 *)
(* ------------------------------------------------------------------------- *)

val EQUIINTEGRABLE_ON_NULL = store_thm ("EQUIINTEGRABLE_ON_NULL",
 ``!fs:(real->real)->bool a b.
     (content(interval[a,b]) = &0) ==> fs equiintegrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[equiintegrable_on] THEN
  ASM_SIMP_TAC std_ss [INTEGRABLE_ON_NULL] THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  EXISTS_TAC ``\x:real. ball(x,&1)`` THEN REWRITE_TAC[GAUGE_TRIVIAL] THEN
  FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP (REWRITE_RULE[IMP_CONJ]
                                           SUM_CONTENT_NULL) th]) THEN
  ASM_SIMP_TAC std_ss [INTEGRAL_NULL, REAL_SUB_REFL, ABS_0]);

val lemma1 = prove (
  ``(!x k. (x,k) IN {x,f k | P x k} ==> Q x k) <=>
     (!x k. P x k ==> Q x (f k))``,
    REWRITE_TAC[GSPECIFICATION, PAIR_EQ] THEN
    SET_TAC[]);

val lemma2 = prove (
 ``!f:'b->'b s:('a#'b)->bool.
      FINITE s ==> FINITE {x,f k | (x,k) IN s /\ P x k}``,
    REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN
    EXISTS_TAC ``IMAGE (\(x:'a,k:'b). x,(f k:'b)) s`` THEN
    ASM_SIMP_TAC std_ss [IMAGE_FINITE] THEN
    SIMP_TAC std_ss [SUBSET_DEF, FORALL_PROD, lemma1, IN_IMAGE] THEN
    SIMP_TAC std_ss [EXISTS_PROD, PAIR_EQ] THEN METIS_TAC[]);

val lemma3 = prove (
 ``!f:real->real g:(real->bool)->(real->bool) p.
     FINITE p
     ==> (sum {x,g k |x,k| (x,k) IN p /\ ~(g k = {})}
              (\(x,k). content k * f x) =
          sum (IMAGE (\(x,k). x,g k) p) (\(x,k). content k * f x))``,
    REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN
    ASM_SIMP_TAC std_ss [IMAGE_FINITE, lemma2] THEN
    SIMP_TAC std_ss [IMP_CONJ, FORALL_IN_IMAGE] THEN
    SIMP_TAC std_ss [FORALL_PROD, SUBSET_DEF, IN_IMAGE, EXISTS_PROD] THEN
    SIMP_TAC std_ss [GSPECIFICATION, PAIR_EQ, REAL_ENTIRE, EXISTS_PROD] THEN
    METIS_TAC[CONTENT_EMPTY]);

val lemma4 = prove (
   ``(\(x,l). content (g l) * f x) =
     (\(x,l). content l * f x) o (\(x,l). x,g l)``,
    SIMP_TAC std_ss [FUN_EQ_THM, o_THM, FORALL_PROD]);

val EQUIINTEGRABLE_ON_SPLIT = store_thm ("EQUIINTEGRABLE_ON_SPLIT",
 ``!fs:(real->real)->bool k a b c.
      fs equiintegrable_on (interval[a,b] INTER {x | x <= c}) /\
      fs equiintegrable_on (interval[a,b] INTER {x | x >= c})
      ==> fs equiintegrable_on (interval[a,b])``,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[equiintegrable_on] THEN
  MATCH_MP_TAC(TAUT
   `(a /\ b ==> c) /\ (a /\ b /\ c ==> a' /\ b' ==> c')
    ==> (a /\ a') /\ (b /\ b') ==> c /\ c'`) THEN
  CONJ_TAC THENL
   [REWRITE_TAC[integrable_on] THEN METIS_TAC[HAS_INTEGRAL_SPLIT],
    STRIP_TAC] THEN
  SUBGOAL_THEN
   ``!f:real->real.
        f IN fs
        ==> (integral (interval[a,b]) f =
                integral (interval [a,b] INTER {x | x <= c}) f +
                integral (interval [a,b] INTER {x | x >= c}) f)``
   (fn th => SIMP_TAC std_ss [th])
  THENL
   [REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN
    MATCH_MP_TAC HAS_INTEGRAL_SPLIT THEN
    MAP_EVERY EXISTS_TAC [``c:real``] THEN
    ASM_SIMP_TAC std_ss [GSYM HAS_INTEGRAL_INTEGRAL],
    ALL_TAC] THEN
  DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN STRIP_TAC THEN
  FIRST_X_ASSUM(CONJUNCTS_THEN2 (MP_TAC o SPEC ``e / &2:real``) STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN ``d2:real->real->bool``
   (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN ``d1:real->real->bool``
   (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN
  EXISTS_TAC ``\x. if x = c then (d1(x:real) INTER d2(x)):real->bool
                  else ball(x,abs(x - c)) INTER d1(x) INTER d2(x)`` THEN
  CONJ_TAC THENL
   [REWRITE_TAC[gauge_def] THEN GEN_TAC THEN
    RULE_ASSUM_TAC(REWRITE_RULE[gauge_def]) THEN
    SIMP_TAC std_ss [] THEN COND_CASES_TAC THEN
    ASM_SIMP_TAC std_ss [OPEN_INTER, IN_INTER, OPEN_BALL, IN_BALL] THEN
    ASM_REWRITE_TAC[DIST_REFL, GSYM ABS_NZ, REAL_SUB_0],
    ALL_TAC] THEN
  X_GEN_TAC ``f:real->real`` THEN
  X_GEN_TAC ``p:(real#(real->bool))->bool`` THEN STRIP_TAC THEN
  SUBGOAL_THEN
    ``(!x:real kk. (x,kk) IN p /\ ~(kk INTER {x:real | x <= c} = {})
                    ==> x <= c) /\
     (!x:real kk. (x,kk) IN p /\ ~(kk INTER {x:real | x >= c} = {})
                    ==> x >= c)``
  STRIP_ASSUME_TAC THENL
   [CONJ_TAC THEN FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [FINE]) THEN
    SIMP_TAC std_ss [] THEN DISCH_TAC THEN
    X_GEN_TAC ``x:real`` THEN X_GEN_TAC ``kk:real->bool`` THEN
    POP_ASSUM (MP_TAC o SPECL [``x:real``, ``kk:real->bool``]) THEN
    DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC std_ss [] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL, real_ge] THEN DISCH_THEN
     (MP_TAC o MATCH_MP (SET_RULE ``k SUBSET (a INTER b) ==> k SUBSET a``)) THEN
    DISCH_THEN
     (MP_TAC o MATCH_MP (SET_RULE ``k SUBSET (a INTER b) ==> k SUBSET a``)) THEN
    SIMP_TAC std_ss [SUBSET_DEF, IN_BALL, dist] THEN DISCH_TAC THENL
    [UNDISCH_TAC ``kk INTER {x:real | x <= c} <> {}``,
     UNDISCH_TAC ``kk INTER {x:real | x >= c} <> {}``] THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
    DISCH_THEN(X_CHOOSE_THEN ``u:real`` MP_TAC) THEN
    SIMP_TAC std_ss [IN_INTER, GSPECIFICATION] THEN REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``u:real``) THEN ASM_SIMP_TAC std_ss [] THEN
    ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
    SIMP_TAC std_ss [REAL_NOT_LE, REAL_NOT_LT] THEN STRIP_TAC THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ``abs((x - u:real))`` THEN
    POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC,
    ALL_TAC] THEN
  UNDISCH_TAC ``!f p.
        f IN fs /\
        p tagged_division_of interval [(a,b)] INTER {x | x >= c} /\
        d2 FINE p ==>
        abs (sum p (\(x,k). content k * f x) -
         integral (interval [(a,b)] INTER {x | x >= c}) f) < e / 2`` THEN
  DISCH_TAC THEN
  FIRST_X_ASSUM (MP_TAC o SPEC
   ``{(x:real,kk INTER {x:real | x >= c}) |x,kk|
     (x,kk) IN p /\ ~(kk INTER {x:real | x >= c} = {})}`` o
   SPEC ``f:real->real``) THEN
  UNDISCH_TAC ``!f p.
        f IN fs /\
        p tagged_division_of interval [(a,b)] INTER {x | x <= c} /\
        d1 FINE p ==>
        abs (sum p (\(x,k). content k * f x) -
         integral (interval [(a,b)] INTER {x | x <= c}) f) < e / 2`` THEN
  DISCH_TAC THEN
  FIRST_X_ASSUM (MP_TAC o SPEC
   ``{(x:real,kk INTER {x:real | x <= c}) |x,kk|
     (x,kk) IN p /\ ~(kk INTER {x:real | x <= c} = {})}`` o
   SPEC ``f:real->real``) THEN
  ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC(TAUT
   `(a /\ b) /\ (a' /\ b' ==> c) ==> (a ==> a') ==> (b ==> b') ==> c`) THEN
  CONJ_TAC THENL
   [UNDISCH_TAC ``p tagged_division_of interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [TAGGED_DIVISION_OF]) THEN
    REWRITE_TAC[TAGGED_DIVISION_OF] THEN
    REPEAT(MATCH_MP_TAC(TAUT
     `(a ==> (a' /\ a'')) /\ (b ==> (b' /\ d) /\ (b'' /\ e))
      ==> a /\ b ==> ((a' /\ b') /\ d) /\ ((a'' /\ b'') /\ e)`) THEN
      CONJ_TAC) THEN
    SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
    SIMP_TAC std_ss [lemma1] THEN REWRITE_TAC[AND_IMP_INTRO] THENL
     [SIMP_TAC std_ss [lemma2],
      SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN
      DISCH_TAC THEN X_GEN_TAC ``x:real`` THEN X_GEN_TAC ``kk:real->bool`` THEN
      POP_ASSUM (MP_TAC o SPECL [``x:real``,``kk:real->bool``]) THEN
      DISCH_THEN(fn th => CONJ_TAC THEN STRIP_TAC THEN MP_TAC th) THEN
      (ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
        [SIMP_TAC std_ss [IN_INTER, GSPECIFICATION] THEN ASM_MESON_TAC[], ALL_TAC]) THEN
      (MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [SET_TAC[], ALL_TAC]) THEN
      METIS_TAC[INTERVAL_SPLIT],
      DISCH_THEN(fn th => CONJ_TAC THEN MP_TAC th) THEN
      (DISCH_TAC THEN X_GEN_TAC ``x1:real`` THEN X_GEN_TAC ``k1:real->bool`` THEN
       POP_ASSUM (MP_TAC o SPECL [``x1:real``,``k1:real->bool``]) THEN
       DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC std_ss [] THEN
       DISCH_TAC THEN X_GEN_TAC ``x2:real`` THEN X_GEN_TAC ``k2:real->bool`` THEN
       POP_ASSUM (MP_TAC o SPECL [``x2:real``,``k2:real->bool``]) THEN
       DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC std_ss [] THEN
       (KNOW_TAC ``(x1 <> x2:real) \/ (k1 <> k2:real->bool)`` THENL
       [METIS_TAC[PAIR_EQ], ALL_TAC] THEN DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
       MATCH_MP_TAC(SET_RULE
        ``s SUBSET s' /\ t SUBSET t'
         ==> (s' INTER t' = {}) ==> (s INTER t = {})``) THEN
       CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[])),
      ALL_TAC] THEN
    MATCH_MP_TAC(TAUT `(a ==> b /\ c) /\ d /\ e
                       ==> (a ==> (b /\ d) /\ (c /\ e))`) THEN
    CONJ_TAC THENL
     [DISCH_THEN(fn th => CONJ_TAC THEN MP_TAC th) THEN
      DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[INTER_BIGUNION] THEN
      ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[IN_BIGUNION] THEN
      X_GEN_TAC ``x:real`` THEN AP_TERM_TAC THEN
      GEN_REWR_TAC I [FUN_EQ_THM] THEN X_GEN_TAC ``kk:real->bool`` THEN
      SIMP_TAC std_ss [GSPECIFICATION, PAIR_EQ, EXISTS_PROD] THEN
      METIS_TAC[NOT_IN_EMPTY],
      ALL_TAC] THEN
    UNDISCH_TAC ``(\x.
         if x = c then d1 x INTER d2 x
         else ball (x,abs (x - c)) INTER d1 x INTER d2 x) FINE p`` THEN DISCH_TAC THEN
    CONJ_TAC THEN FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [FINE]) THEN
    SIMP_TAC std_ss [FINE,  lemma1] THEN
    DISCH_TAC THEN X_GEN_TAC ``x:real`` THEN X_GEN_TAC ``k:real->bool`` THEN
       POP_ASSUM (MP_TAC o SPECL [``x:real``,``k:real->bool``]) THEN
    DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN
    ASM_SIMP_TAC std_ss [] THEN SET_TAC[],
    ALL_TAC] THEN
  GEN_REWR_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_HALF] THEN
  DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
   ``x < e / &2 /\ y < e / &2 ==> x + y < e / 2 + e / 2:real``)) THEN
  REWRITE_TAC [REAL_HALF] THEN
  DISCH_THEN(MP_TAC o MATCH_MP ABS_TRIANGLE_LT) THEN
  MATCH_MP_TAC EQ_IMPLIES THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
  REWRITE_TAC[REAL_ARITH
   ``((a - i) + (b - j) = c - (i + j)) <=> (a + b = c:real)``] THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
 MATCH_MP_TAC EQ_TRANS THEN
  EXISTS_TAC
   ``sum p (\(x,l). content (l INTER {x:real | x <= c}) *
                     (f:real->real) x) +
     sum p (\(x,l). content (l INTER {x:real | x >= c}) *
                     (f:real->real) x)`` THEN
  CONJ_TAC THENL
   [ALL_TAC,
    ASM_SIMP_TAC std_ss [GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_EQ THEN
    SIMP_TAC std_ss [FORALL_PROD, GSYM REAL_ADD_RDISTRIB] THEN
    MAP_EVERY X_GEN_TAC [``x:real``, ``l:real->bool``] THEN
    DISCH_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
    UNDISCH_TAC ``p tagged_division_of interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [TAGGED_DIVISION_OF]) THEN
    DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
    DISCH_THEN(MP_TAC o SPECL [``x:real``, ``l:real->bool``]) THEN
    ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
    ASM_SIMP_TAC std_ss [GSYM CONTENT_SPLIT]] THEN
  ASM_SIMP_TAC std_ss [lemma3] THEN BINOP_TAC THENL
  [ONCE_REWRITE_TAC [METIS []
     ``(\(x,l). content (l INTER {x | x <= c}) * f x) =
       (\(x,l). content ((\l. l INTER {x | x <= c}) l) * f x)``],
   ONCE_REWRITE_TAC [METIS []
     ``(\(x,l). content (l INTER {x | x >= c}) * f x) =
       (\(x,l). content ((\l. l INTER {x | x >= c}) l) * f x)``]] THEN
  (GEN_REWR_TAC (RAND_CONV o RAND_CONV) [lemma4] THEN
   SIMP_TAC std_ss [] THEN
   MATCH_MP_TAC SUM_IMAGE_NONZERO THEN ASM_SIMP_TAC std_ss [FORALL_PROD] THEN
   SIMP_TAC std_ss [PAIR_EQ] THEN
   METIS_TAC[TAGGED_DIVISION_SPLIT_LEFT_INJ, REAL_MUL_LZERO,
             TAGGED_DIVISION_SPLIT_RIGHT_INJ]));

val EQUIINTEGRABLE_DIVISION = store_thm ("EQUIINTEGRABLE_DIVISION",
 ``!fs:(real->real)->bool d a b.
        d division_of interval[a,b]
        ==> (fs equiintegrable_on interval[a,b] <=>
             !i. i IN d ==> fs equiintegrable_on i)``,
  REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
  MATCH_MP_TAC OPERATIVE_DIVISION_AND THEN
  ASM_REWRITE_TAC[operative, NEUTRAL_AND] THEN
  POP_ASSUM_LIST(K ALL_TAC) THEN CONJ_TAC THENL
   [MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN DISCH_TAC THEN
    ASM_SIMP_TAC std_ss [equiintegrable_on, INTEGRABLE_ON_NULL] THEN
    GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC ``\x:real. ball(x,&1)`` THEN
    ASM_SIMP_TAC std_ss [GAUGE_TRIVIAL, INTEGRAL_NULL, REAL_SUB_RZERO] THEN
    REPEAT STRIP_TAC THEN
    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
     ``&0 < e ==> (x = 0) ==> abs x < e:real``)) THEN
    MATCH_MP_TAC SUM_EQ_0 THEN SIMP_TAC std_ss [FORALL_PROD] THEN
    REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN
    RULE_ASSUM_TAC(REWRITE_RULE[TAGGED_DIVISION_OF]) THEN
    ASM_MESON_TAC[CONTENT_EQ_0_INTERIOR, SUBSET_INTERIOR,
                  SET_RULE ``(s = {}) <=> s SUBSET {}``],
    ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``, ``c:real``] THEN
  EQ_TAC THENL [ALL_TAC, METIS_TAC[EQUIINTEGRABLE_ON_SPLIT]] THEN
  ASM_SIMP_TAC std_ss [INTEGRABLE_SPLIT, equiintegrable_on] THEN
  STRIP_TAC THEN CONJ_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  (FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
   DISCH_THEN (X_CHOOSE_TAC ``d:real->real->bool``) THEN
   EXISTS_TAC ``d:real->real->bool`` THEN POP_ASSUM MP_TAC THEN
   ASM_CASES_TAC ``gauge(d:real->real->bool)`` THEN ASM_REWRITE_TAC[] THEN
   DISCH_TAC THEN X_GEN_TAC ``f:real->real`` THEN
   POP_ASSUM (MP_TAC o SPEC ``f:real->real``) THEN
   ASM_CASES_TAC ``(f:real->real) IN fs`` THEN ASM_REWRITE_TAC[] THEN
   DISCH_TAC THEN
   MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``b:real``,
                  ``d:real->real->bool``, ``e / &2:real``]
         HENSTOCK_LEMMA_PART1) THEN ASM_SIMP_TAC std_ss [REAL_HALF] THEN
   DISCH_TAC THEN X_GEN_TAC ``p:real#(real->bool)->bool`` THEN
   POP_ASSUM (MP_TAC o SPEC ``p:real#(real->bool)->bool``) THEN
   DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN
   KNOW_TAC ``p tagged_partial_division_of interval [(a,b)] /\ d FINE p`` THENL
    [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TAGGED_PARTIAL_DIVISION_OF_SUBSET THEN
     RULE_ASSUM_TAC(REWRITE_RULE[tagged_division_of]) THEN
     ASM_MESON_TAC[INTER_SUBSET],
     DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
   GEN_REWR_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_HALF] THEN
   MATCH_MP_TAC(REAL_ARITH
    ``&0 < e / 2 /\ (x:real = y) ==> abs(x) <= e / &2 ==> abs(y) < e / 2 + e / 2``) THEN
   ASM_REWRITE_TAC[REAL_HALF] THEN ASM_SIMP_TAC std_ss [INTERVAL_SPLIT] THEN
   W(MP_TAC o PART_MATCH (lhand o rand)
     INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN o rand o rand o snd) THEN
   ASM_SIMP_TAC std_ss [GSYM INTERVAL_SPLIT, INTEGRABLE_SPLIT] THEN
   DISCH_THEN SUBST1_TAC THEN
   FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
   ASM_SIMP_TAC std_ss [GSYM SUM_SUB] THEN MATCH_MP_TAC SUM_EQ THEN
   SIMP_TAC std_ss [FORALL_PROD]));

(* ------------------------------------------------------------------------- *)
(* Main limit theorem for an equiintegrable sequence.                        *)
(* ------------------------------------------------------------------------- *)

val EQUIINTEGRABLE_LIMIT = store_thm ("EQUIINTEGRABLE_LIMIT",
 ``!f g:real->real a b.
        {f n | n IN univ(:num)} equiintegrable_on interval[a,b] /\
        (!x. x IN interval[a,b] ==> ((\n. f n x) --> g x) sequentially)
        ==> g integrable_on interval[a,b] /\
            ((\n. integral(interval[a,b]) (f n)) --> integral(interval[a,b]) g)
            sequentially``,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  ASM_CASES_TAC ``content(interval[a:real,b]) = &0`` THEN
  ASM_SIMP_TAC std_ss [INTEGRABLE_ON_NULL, INTEGRAL_NULL, LIM_CONST] THEN
  SUBGOAL_THEN ``cauchy (\n. integral(interval[a,b]) (f n :real->real))``
  MP_TAC THENL
   [REWRITE_TAC[cauchy] THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
    UNDISCH_TAC ``{f n | n IN univ(:num)} equiintegrable_on interval [(a,b)]`` THEN
    DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o REWRITE_RULE [equiintegrable_on]) THEN
    SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM, FORALL_IN_GSPEC, IN_UNIV] THEN
    DISCH_TAC THEN REWRITE_TAC[AND_IMP_INTRO, GSYM CONJ_ASSOC] THEN
    DISCH_THEN(MP_TAC o SPEC ``e / &3:real``) THEN
    KNOW_TAC ``0 < e / 3:real`` THENL [UNDISCH_TAC ``0 < e:real`` THEN
     SIMP_TAC real_ss [REAL_LT_RDIV_EQ] THEN REAL_ARITH_TAC,
     DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN ``d:real->real->bool`` STRIP_ASSUME_TAC) THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP FINE_DIVISION_EXISTS) THEN
    DISCH_THEN(MP_TAC o SPECL [``a:real``, ``b:real``]) THEN
    DISCH_THEN(X_CHOOSE_THEN ``p:(real#(real->bool))->bool``
        STRIP_ASSUME_TAC) THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
    FIRST_X_ASSUM(MP_TAC o GEN ``n:num`` o SPECL
     [``n:num``, ``p:(real#(real->bool))->bool``]) THEN
    ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN
     ``cauchy (\n. sum p (\(x,k:real->bool).
               content k * (f:num->real->real) n x))``
    MP_TAC THENL
     [MATCH_MP_TAC CONVERGENT_IMP_CAUCHY THEN
      EXISTS_TAC ``sum p (\(x,k:real->bool).
          content k * (g:real->real) x)`` THEN
      MATCH_MP_TAC
       (SIMP_RULE std_ss [LAMBDA_PROD]
        (SIMP_RULE std_ss [FORALL_PROD]
         (ISPECL [``sequentially``, ``\(x:real,k:real->bool) (n:num).
                  content k * (f n x:real)``] LIM_SUM))) THEN
      ASM_SIMP_TAC std_ss [] THEN
      MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN DISCH_TAC THEN
      ONCE_REWRITE_TAC [METIS [] ``(\n. content k * f n x) =
                                   (\n. content k * (\n. f n x) n)``] THEN
      MATCH_MP_TAC LIM_CMUL THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      UNDISCH_TAC ``p tagged_division_of interval [(a,b)]`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [TAGGED_DIVISION_OF]) THEN
      ASM_SIMP_TAC std_ss [SUBSET_DEF] THEN ASM_MESON_TAC[],
      REWRITE_TAC[cauchy] THEN DISCH_THEN(MP_TAC o SPEC ``e / &3:real``) THEN
      KNOW_TAC ``0 < e / 3:real`` THENL [UNDISCH_TAC ``0 < e:real`` THEN
       SIMP_TAC real_ss [REAL_LT_RDIV_EQ] THEN REAL_ARITH_TAC,
       DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
      SIMP_TAC std_ss [AND_IMP_INTRO, RIGHT_IMP_FORALL_THM, GE] THEN
      DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
      X_GEN_TAC ``m:num`` THEN X_GEN_TAC ``n:num`` THEN
      POP_ASSUM (MP_TAC o SPECL [``m:num``,``n:num``]) THEN
      ASM_CASES_TAC ``N:num <= m /\ N <= n`` THEN ASM_REWRITE_TAC[dist] THEN
      SIMP_TAC real_ss [REAL_LT_RDIV_EQ] THEN
      MATCH_MP_TAC(REAL_ARITH
       ``abs(sm - gm:real) * 3 < e /\ abs(sn - gn) * 3 < e
        ==> abs (sm - sn) * 3 < e ==> abs(gm - gn) < e:real``) THEN
      ASM_SIMP_TAC real_ss [GSYM REAL_LT_RDIV_EQ]],

    REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN
    DISCH_THEN(X_CHOOSE_TAC ``l:real``) THEN
    SUBGOAL_THEN ``((g:real->real) has_integral l) (interval[a,b])``
     (fn th => METIS_TAC[th, integrable_on, INTEGRAL_UNIQUE]) THEN
    REWRITE_TAC[has_integral] THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
    UNDISCH_TAC ``{f n | n IN univ(:num)} equiintegrable_on interval [(a,b)]`` THEN
    DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o REWRITE_RULE [equiintegrable_on]) THEN
    SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM, FORALL_IN_GSPEC, IN_UNIV] THEN
    DISCH_TAC THEN SIMP_TAC std_ss [AND_IMP_INTRO, GSYM CONJ_ASSOC] THEN
    DISCH_THEN(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
    DISCH_THEN (X_CHOOSE_TAC ``d:real->real->bool``) THEN
    EXISTS_TAC ``d:real->real->bool`` THEN POP_ASSUM MP_TAC THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    X_GEN_TAC ``p:(real#(real->bool))->bool`` THEN STRIP_TAC THEN
    GEN_REWR_TAC (RAND_CONV) [GSYM REAL_HALF] THEN
    MATCH_MP_TAC(REAL_ARITH
     ``&0 < e / 2 /\ x <= e / &2 ==> x < e / 2 + e / 2:real``) THEN
    ASM_REWRITE_TAC[REAL_HALF] THEN
    MATCH_MP_TAC(ISPEC ``sequentially`` LIM_ABS_UBOUND) THEN
    EXISTS_TAC ``\n:num. sum p (\(x,k:real->bool). content k * f n x) -
                       integral (interval [a,b]) (f n :real->real)`` THEN
    ASM_SIMP_TAC std_ss [TRIVIAL_LIMIT_SEQUENTIALLY, REAL_LT_IMP_LE] THEN
    REWRITE_TAC[EVENTUALLY_TRUE] THEN
    ONCE_REWRITE_TAC [METIS []
     ``(\n. sum p (\(x,k). content k * f n x) -
            integral (interval [(a,b)]) (f n)) =
       (\n. (\n. sum p (\(x,k). content k * f n x)) n -
            (\n. integral (interval [(a,b)]) (f n)) n)``] THEN
    MATCH_MP_TAC LIM_SUB THEN ASM_SIMP_TAC std_ss [] THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
    MATCH_MP_TAC
     (SIMP_RULE std_ss [LAMBDA_PROD]
      (SIMP_RULE std_ss [FORALL_PROD]
       (ISPECL [``sequentially``, ``\(x:real,k:real->bool) (n:num).
                content k * (f n x:real)``] LIM_SUM))) THEN
    ASM_REWRITE_TAC [] THEN
    MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN DISCH_TAC THEN
    SIMP_TAC std_ss [] THEN
    ONCE_REWRITE_TAC[METIS [] ``(\n. content k * f n x) =
                                (\n. content k * (\n. f n x) n)``] THEN
    MATCH_MP_TAC LIM_CMUL THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    UNDISCH_TAC ``p tagged_division_of interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [TAGGED_DIVISION_OF]) THEN
    ASM_SIMP_TAC std_ss [SUBSET_DEF] THEN ASM_MESON_TAC[]]);

(* ------------------------------------------------------------------------- *)
(* Combining theorems for the set of equiintegrable functions.               *)
(* ------------------------------------------------------------------------- *)

val EQUIINTEGRABLE_SUBSET = store_thm ("EQUIINTEGRABLE_SUBSET",
 ``!fs gs s.
   fs equiintegrable_on s /\ gs SUBSET fs ==> gs equiintegrable_on s``,
  REWRITE_TAC[equiintegrable_on, SUBSET_DEF] THEN METIS_TAC[]);

val EQUIINTEGRABLE_UNION = store_thm ("EQUIINTEGRABLE_UNION",
 ``!fs:(real->real)->bool gs s.
        fs equiintegrable_on s /\ gs equiintegrable_on s
        ==> (fs UNION gs) equiintegrable_on s``,
  REPEAT GEN_TAC THEN REWRITE_TAC[equiintegrable_on, IN_UNION] THEN
  REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
  SIMP_TAC std_ss [FORALL_AND_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC ``e:real``)) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN ``d1:real->real->bool`` STRIP_ASSUME_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN ``d2:real->real->bool`` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC ``\x. (d1:real->real->bool) x INTER d2 x`` THEN
  ASM_SIMP_TAC std_ss [GAUGE_INTER, FINE_INTER] THEN
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC std_ss []);

val EQUIINTEGRABLE_EQ = store_thm ("EQUIINTEGRABLE_EQ",
 ``!fs gs:(real->real)->bool s.
        fs equiintegrable_on s /\
        (!g. g IN gs ==> ?f. f IN fs /\ (!x. x IN s ==> (f x = g x)))
        ==> gs equiintegrable_on s``,
  REPEAT GEN_TAC THEN REWRITE_TAC[equiintegrable_on] THEN
  DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC ASSUME_TAC) THEN
  CONJ_TAC THENL
   [X_GEN_TAC ``g:real->real`` THEN DISCH_TAC THEN
    UNDISCH_TAC ``!g:real->real. g IN gs ==> ?f. f IN fs /\ !x. x IN s ==>
                 (f x = g x)`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM (MP_TAC o SPEC ``g:real->real``) THEN
    ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC ``f:real->real`` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``f:real->real``) THEN
    ASM_MESON_TAC[INTEGRABLE_SPIKE, IN_DIFF, NEGLIGIBLE_EMPTY],
    X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``e:real``) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN (X_CHOOSE_TAC ``d:real->real->bool``) THEN
    EXISTS_TAC ``d:real->real->bool`` THEN POP_ASSUM MP_TAC THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    MAP_EVERY X_GEN_TAC
     [``g:real->real``, ``p:(real#(real->bool))->bool``] THEN STRIP_TAC THEN
    UNDISCH_TAC ``!g:real->real. g IN gs ==> ?f. f IN fs /\ !x. x IN s ==>
                 (f x = g x)`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM (MP_TAC o SPEC ``g:real->real``) THEN
    ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC ``f:real->real`` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL
     [``f:real->real``, ``p:(real#(real->bool))->bool``]) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[]
     ``(x:real = y) /\ (a = b) ==> abs(x - a) < e ==> abs(y - b) < e:real``) THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC SUM_EQ THEN SIMP_TAC std_ss [FORALL_PROD] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[TAGGED_DIVISION_OF, SUBSET_DEF]) THEN
      ASM_MESON_TAC[],
      ASM_MESON_TAC[INTEGRAL_EQ]]]);

val EQUIINTEGRABLE_CMUL = store_thm ("EQUIINTEGRABLE_CMUL",
 ``!fs:(real->real)->bool s k.
        fs equiintegrable_on s
        ==> {(\x. c * f x) | abs(c) <= k /\ f IN fs} equiintegrable_on s``,
  REPEAT GEN_TAC THEN
  SIMP_TAC std_ss [equiintegrable_on, INTEGRABLE_CMUL, FORALL_IN_GSPEC] THEN
  STRIP_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM, FORALL_IN_GSPEC] THEN
  ASM_SIMP_TAC std_ss [RIGHT_IMP_FORALL_THM, INTEGRAL_CMUL, AND_IMP_INTRO] THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``e / (abs(k) + &1:real)``) THEN
  ASM_SIMP_TAC std_ss [REAL_LT_RDIV_EQ, REAL_MUL_LZERO,
               REAL_ARITH ``&0 < abs(k) + &1:real``] THEN
  DISCH_THEN (X_CHOOSE_TAC ``d:real->real->bool``) THEN
    EXISTS_TAC ``d:real->real->bool`` THEN POP_ASSUM MP_TAC THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  MAP_EVERY X_GEN_TAC [``c:real``, ``f:real->real``,
                       ``p:(real#(real->bool))->bool``] THEN
  STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o
   SPECL [``f:real->real``, ``p:(real#(real->bool))->bool``]) THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN
  MATCH_MP_TAC(REAL_ARITH ``&0 <= y /\ x <= c * y ==> x <= y * (c + &1:real)``) THEN
  REWRITE_TAC[ABS_POS] THEN MATCH_MP_TAC(REAL_ARITH
   ``!c. (x = c * y) /\ c *  y <= k * y ==> x <= k * y:real``) THEN
  EXISTS_TAC ``abs c:real`` THEN CONJ_TAC THENL
   [REWRITE_TAC[GSYM ABS_MUL, GSYM SUM_LMUL, REAL_SUB_LDISTRIB] THEN
    SIMP_TAC std_ss [LAMBDA_PROD, REAL_MUL_ASSOC] THEN
    SIMP_TAC std_ss [REAL_MUL_SYM],
    MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN
    UNDISCH_TAC ``abs c <= k:real`` THEN REAL_ARITH_TAC]);

val EQUIINTEGRABLE_ADD = store_thm ("EQUIINTEGRABLE_ADD",
 ``!fs:(real->real)->bool gs s.
        fs equiintegrable_on s /\ gs equiintegrable_on s
        ==> {(\x. f x + g x) | f IN fs /\ g IN gs} equiintegrable_on s``,
  REPEAT GEN_TAC THEN
  SIMP_TAC std_ss [equiintegrable_on, INTEGRABLE_ADD, FORALL_IN_GSPEC] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)
   (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM, FORALL_IN_GSPEC] THEN
  ASM_SIMP_TAC std_ss [RIGHT_IMP_FORALL_THM, INTEGRAL_ADD, AND_IMP_INTRO] THEN
  FIRST_X_ASSUM (MP_TAC o SPEC ``e / &2:real``) THEN
  FIRST_X_ASSUM (MP_TAC o SPEC ``e / &2:real``) THEN
  ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN ``d1:real->real->bool``
   (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN ``d2:real->real->bool``
   (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN
  EXISTS_TAC ``\x. (d1:real->real->bool) x INTER d2 x`` THEN
  ASM_SIMP_TAC std_ss [GAUGE_INTER, FINE_INTER] THEN
  MAP_EVERY X_GEN_TAC [``f:real->real``, ``g:real->real``,
                       ``p:(real#(real->bool))->bool``] THEN STRIP_TAC THEN
  FIRST_X_ASSUM (MP_TAC o SPECL
   [``g:real->real``, ``p:(real#(real->bool))->bool``]) THEN
  FIRST_X_ASSUM (MP_TAC o SPECL
   [``f:real->real``, ``p:(real#(real->bool))->bool``]) THEN
  ASM_REWRITE_TAC[] THEN
  GEN_REWR_TAC (RAND_CONV o RAND_CONV o RAND_CONV) [GSYM REAL_HALF] THEN
  MATCH_MP_TAC(REAL_ARITH
   ``(s + s' = t)
    ==> abs(s - i) < e / &2 ==> abs(s' - i') < e / &2
        ==> abs(t - (i + i')) < e / 2 + e / 2:real``) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
  ASM_SIMP_TAC std_ss [GSYM SUM_ADD] THEN
  SIMP_TAC std_ss [LAMBDA_PROD, REAL_ADD_LDISTRIB]);

val EQUIINTEGRABLE_NEG = store_thm ("EQUIINTEGRABLE_NEG",
 ``!fs:(real->real)->bool s.
        fs equiintegrable_on s
        ==> {(\x. -(f x)) | f IN fs} equiintegrable_on s``,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o SPEC ``&1:real`` o MATCH_MP EQUIINTEGRABLE_CMUL) THEN
  MATCH_MP_TAC (REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN
  SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_GSPEC] THEN
  SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN
  X_GEN_TAC ``f:real->real`` THEN DISCH_TAC THEN EXISTS_TAC ``- &1:real`` THEN
  EXISTS_TAC ``f:real->real`` THEN
  ASM_REWRITE_TAC[REAL_MUL_LNEG, REAL_MUL_LID] THEN REAL_ARITH_TAC);

val EQUIINTEGRABLE_SUB = store_thm ("EQUIINTEGRABLE_SUB",
 ``!fs:(real->real)->bool gs s.
        fs equiintegrable_on s /\ gs equiintegrable_on s
        ==> {(\x. f x - g x) | f IN fs /\ g IN gs} equiintegrable_on s``,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2
   MP_TAC (MP_TAC o MATCH_MP EQUIINTEGRABLE_NEG)) THEN
  REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
  DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_ADD) THEN
  MATCH_MP_TAC (REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN
  SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_GSPEC] THEN
  SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN
  MAP_EVERY X_GEN_TAC [``f:real->real``, ``g:real->real``] THEN
  STRIP_TAC THEN EXISTS_TAC ``f:real->real`` THEN
  EXISTS_TAC ``\x. -((g:real->real) x)`` THEN
  ASM_SIMP_TAC std_ss [real_sub] THEN EXISTS_TAC ``g:real->real`` THEN
  ASM_REWRITE_TAC[]);

val EQUIINTEGRABLE_SUM = store_thm ("EQUIINTEGRABLE_SUM",
 ``!fs:(real->real)->bool a b.
        fs equiintegrable_on interval[a,b]
        ==> {(\x. sum t (\i. c i * f i x)) |
               FINITE t /\
               (!i:'a. i IN t ==> &0 <= c i /\ (f i) IN fs) /\
               (sum t c = &1)}
            equiintegrable_on interval[a,b]``,
  REPEAT GEN_TAC THEN REWRITE_TAC[equiintegrable_on] THEN
  SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM, FORALL_IN_GSPEC] THEN
  SIMP_TAC std_ss [AND_IMP_INTRO, GSYM CONJ_ASSOC, RIGHT_IMP_FORALL_THM] THEN
  STRIP_TAC THEN CONJ_TAC THENL
  [REPEAT STRIP_TAC THEN
   ONCE_REWRITE_TAC [METIS []
    ``(\x. sum t (\i. c i * f i x)) = (\x. sum t (\i. (\i x. c i * f i x) i x))``] THEN
   MATCH_MP_TAC INTEGRABLE_SUM THEN ASM_SIMP_TAC std_ss [] THEN GEN_TAC THEN
   STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN FIRST_ASSUM MATCH_MP_TAC THEN
   METIS_TAC [], ALL_TAC] THEN ASM_SIMP_TAC std_ss [INTEGRAL_SUM] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN (X_CHOOSE_TAC ``d:real->real->bool``) THEN
  EXISTS_TAC ``d:real->real->bool`` THEN POP_ASSUM MP_TAC THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC
   [``t:'a->bool``, ``c:'a->real``, ``f:'a->real->real``,
    ``p:(real#(real->bool))->bool``] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN
   ``!i:'a. i IN t
          ==> (integral (interval[a,b]) (\x:real. c i * f i x:real) =
               sum p (\(x:real,k).
                       integral (k:real->bool) (\x:real. c i * f i x)))``
   (fn th => SIMP_TAC std_ss [th])
  THENL
   [REPEAT STRIP_TAC THEN
    MATCH_MP_TAC INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN THEN
   METIS_TAC [INTEGRABLE_CMUL, ETA_AX],
    ALL_TAC] THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
  SUBGOAL_THEN
   ``sum p (\(x,k:real->bool). content k * sum t (\i. c i * f i x)) =
     sum t (\i. c i *
                sum p (\(x,k). content k * (f:'a->real->real) i x))``
  SUBST1_TAC THENL
   [SIMP_TAC std_ss [GSYM SUM_LMUL] THEN
    ONCE_REWRITE_TAC [METIS []
     ``(\i. sum p (\x. c i * (\(x,k). content k * f i x) x)) =
       (\i. sum p ((\i. (\x. c i * (\(x,k). content k * f i x) x)) i))``] THEN
    W(MP_TAC o PART_MATCH (lhs o rand) SUM_SWAP o
      rand o snd) THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
    MATCH_MP_TAC SUM_EQ THEN SIMP_TAC std_ss [FORALL_PROD, REAL_MUL_ASSOC] THEN
    REPEAT STRIP_TAC THEN GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV)
     [REAL_ARITH ``a * b * c = b * a * c:real``] THEN SIMP_TAC std_ss [],
    ALL_TAC] THEN
  MATCH_MP_TAC REAL_LET_TRANS THEN
  EXISTS_TAC ``sum t (\i:'a. c i * e / &2)`` THEN CONJ_TAC THENL
   [ALL_TAC,
    ASM_SIMP_TAC real_ss [real_div, SUM_RMUL, ETA_AX, REAL_MUL_LID] THEN
    REWRITE_TAC [GSYM real_div] THEN SIMP_TAC real_ss [REAL_LT_LDIV_EQ] THEN
    UNDISCH_TAC ``0 < e:real`` THEN REAL_ARITH_TAC] THEN
  KNOW_TAC ``integral (interval [(a,b)]) (\x. sum t (\i. c i * f i x)) =
             integral (interval [(a,b)]) (\x. sum t (\i. (\i x. c i * f i x) i x))`` THENL
  [SIMP_TAC std_ss [], DISCH_THEN (fn th => REWRITE_TAC [th])] THEN
  KNOW_TAC ``integral (interval [(a,b)]) (\x. sum t (\i. (\i x. c i * f i x) i x)) =
             sum t (\i. integral (interval [(a,b)]) ((\i x. c i * f i x) i))`` THENL
   [MATCH_MP_TAC INTEGRAL_SUM THEN ASM_SIMP_TAC std_ss [] THEN
    REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN METIS_TAC [],
    SIMP_TAC std_ss [] THEN DISCH_THEN (fn th => SIMP_TAC std_ss [th])] THEN
  ASM_SIMP_TAC std_ss [GSYM SUM_SUB] THEN MATCH_MP_TAC SUM_ABS_LE THEN
  ASM_REWRITE_TAC[] THEN X_GEN_TAC ``i:'a`` THEN DISCH_TAC THEN
  ASM_SIMP_TAC std_ss [GSYM SUM_LMUL, GSYM SUM_SUB] THEN
  SIMP_TAC std_ss [LAMBDA_PROD] THEN FIRST_X_ASSUM(MP_TAC o SPECL
   [``(f:'a->real->real) i``, ``p:(real#(real->bool))->bool``]) THEN
  ASM_SIMP_TAC std_ss [] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN
  DISCH_THEN(MP_TAC o SPEC ``abs((c:'a->real) i)`` o
    MATCH_MP(SIMP_RULE std_ss [IMP_CONJ_ALT] REAL_LE_LMUL_IMP)) THEN
  ASM_REWRITE_TAC[ABS_POS, GSYM ABS_MUL] THEN
  ASM_SIMP_TAC std_ss [GSYM SUM_LMUL, REAL_SUB_LDISTRIB] THEN
  KNOW_TAC `` abs ((c:'a->real) i) = c i`` THENL
  [ASM_SIMP_TAC std_ss [abs], DISCH_THEN (fn th => REWRITE_TAC [th])] THEN
  SIMP_TAC std_ss [LAMBDA_PROD] THEN
  REWRITE_TAC [REAL_MUL_ASSOC, real_div] THEN
  MATCH_MP_TAC(REAL_ARITH ``(x = y) ==> x <= a ==> y <= a:real``) THEN
  AP_TERM_TAC THEN
  KNOW_TAC
  ``integral (interval [(a,b)]) (\(x :real). c i * (f :'a -> real -> real) i x) =
             (c:'a->real) i * integral (interval [(a,b)]) (f i)`` THENL
  [MATCH_MP_TAC INTEGRAL_CMUL THEN METIS_TAC [],
   DISCH_THEN (fn th => REWRITE_TAC [th])]);

val EQUIINTEGRABLE_UNIFORM_LIMIT = store_thm ("EQUIINTEGRABLE_UNIFORM_LIMIT",
 ``!fs:(real->real)->bool a b.
        fs equiintegrable_on interval[a,b]
        ==> {g | !e. &0 < e
                     ==> ?f. f IN fs /\
                             !x. x IN interval[a,b] ==> abs(g x - f x) < e}
            equiintegrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o REWRITE_RULE [equiintegrable_on]) THEN
  SIMP_TAC std_ss [equiintegrable_on, GSPECIFICATION] THEN REPEAT GEN_TAC THEN
  STRIP_TAC THEN CONJ_TAC THENL
   [ASM_MESON_TAC[INTEGRABLE_UNIFORM_LIMIT, REAL_LT_IMP_LE], ALL_TAC] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``e / &2:real``) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN (X_CHOOSE_TAC ``d:real->real->bool``) THEN
  EXISTS_TAC ``d:real->real->bool`` THEN POP_ASSUM MP_TAC THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC
   [``g:real->real``,``p:(real#(real->bool))->bool``] THEN
  STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
  SUBGOAL_THEN ``(g:real->real) integrable_on interval[a,b]``
  ASSUME_TAC THENL
   [ASM_MESON_TAC[INTEGRABLE_UNIFORM_LIMIT, REAL_LT_IMP_LE], ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o GEN ``n:num`` o SPEC ``inv(&n + &1:real)``) THEN
  SIMP_TAC std_ss [REAL_LT_INV_EQ,
   METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0] ``&0 < &n + &1:real``] THEN
  SIMP_TAC std_ss [SKOLEM_THM, FORALL_AND_THM, LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC ``f:num->real->real`` THEN STRIP_TAC THEN
  SUBGOAL_THEN
   ``!x. x IN interval[a,b]
        ==> ((\n. f n x) --> (g:real->real) x) sequentially``
  ASSUME_TAC THENL
   [X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
    REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC ``k:real`` THEN DISCH_TAC THEN
    MP_TAC(SPEC ``k:real`` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
    POP_ASSUM MP_TAC THEN STRIP_TAC THEN
    X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN REWRITE_TAC [dist] THEN
    ONCE_REWRITE_TAC[REAL_ARITH ``abs(a:real - b) = abs(b - a)``] THEN
    MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC ``inv(&n + &1:real)`` THEN
    ASM_SIMP_TAC std_ss [] THEN
    MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ``inv(&N:real)`` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
    REWRITE_TAC[REAL_OF_NUM_ADD, REAL_OF_NUM_LE, REAL_LT] THEN
    ASM_SIMP_TAC arith_ss [],
    ALL_TAC] THEN
  MP_TAC(ISPECL [``f:num->real->real``, ``g:real->real``,
                 ``a:real``, ``b:real``] EQUIINTEGRABLE_LIMIT) THEN
  KNOW_TAC ``{f n | n IN univ(:num)} equiintegrable_on interval [(a,b)] /\
   (!x. x IN interval [(a,b)] ==> ((\n. f n x) --> g x) sequentially)`` THENL
   [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQUIINTEGRABLE_SUBSET THEN
    EXISTS_TAC ``fs:(real->real)->bool`` THEN ASM_SET_TAC[],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    DISCH_TAC] THEN
  SUBGOAL_THEN
   ``((\n. sum p (\(x,k:real->bool).
                    content k * (f:num->real->real) n x)) -->
     sum p (\(x,k). content k * g x)) sequentially``
   ASSUME_TAC
  THENL
   [MATCH_MP_TAC
       (SIMP_RULE std_ss [LAMBDA_PROD]
        (SIMP_RULE std_ss [FORALL_PROD]
         (ISPECL [``sequentially``, ``\(x:real,k:real->bool) (n:num).
                  content k * (f n x:real)``] LIM_SUM))) THEN
    ASM_REWRITE_TAC[] THEN
    MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN DISCH_TAC THEN
    SIMP_TAC std_ss [] THEN
    ONCE_REWRITE_TAC [METIS [] ``(\n. content k * f n x) =
                                 (\n. content k * (\n. f n x) n)``] THEN
    MATCH_MP_TAC LIM_CMUL THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    UNDISCH_TAC ``p tagged_division_of interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SIMP_RULE std_ss [TAGGED_DIVISION_OF]) THEN
    ASM_SIMP_TAC std_ss [SUBSET_DEF] THEN ASM_MESON_TAC[],
    ALL_TAC] THEN
  FIRST_X_ASSUM (MP_TAC o REWRITE_RULE[LIM_SEQUENTIALLY]) THEN
  DISCH_THEN(MP_TAC o SPEC ``e / &4:real``) THEN
  KNOW_TAC ``0 < e / 4:real`` THENL
  [UNDISCH_TAC ``0 < e:real`` THEN SIMP_TAC real_ss [REAL_LT_RDIV_EQ] THEN
   REAL_ARITH_TAC, DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN ``N1:num`` ASSUME_TAC) THEN
  UNDISCH_TAC ``((\n. integral (interval [(a,b)]) (f n)) -->
        integral (interval [(a,b)]) g) sequentially`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM (MP_TAC o REWRITE_RULE[LIM_SEQUENTIALLY]) THEN
  DISCH_THEN(MP_TAC o SPEC ``e / &4:real``) THEN
  KNOW_TAC ``0 < e / 4:real`` THENL
  [UNDISCH_TAC ``0 < e:real`` THEN SIMP_TAC real_ss [REAL_LT_RDIV_EQ] THEN
   REAL_ARITH_TAC, DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN ``N2:num`` ASSUME_TAC) THEN
  SUBGOAL_THEN ``?n:num. N1 <= n /\ N2 <= n`` STRIP_ASSUME_TAC THENL
   [EXISTS_TAC ``N1 + N2:num`` THEN ARITH_TAC, ALL_TAC] THEN
  FIRST_X_ASSUM (MP_TAC o SPEC ``n:num``) THEN
  FIRST_X_ASSUM (MP_TAC o SPEC ``n:num``) THEN
  FIRST_X_ASSUM(MP_TAC o SPECL
   [``(f:num->real->real) n``, ``p:(real#(real->bool))->bool``]) THEN
  ASM_SIMP_TAC real_ss [dist, REAL_LT_RDIV_EQ] THEN REAL_ARITH_TAC);

val lemma = prove (
   ``(!x k. (x,k) IN IMAGE (\(x,k). f x k,g x k) s ==> Q x k) <=>
     (!x k. (x,k) IN s ==> Q (f x k) (g x k))``,
  SIMP_TAC std_ss [IN_IMAGE, PAIR_EQ, EXISTS_PROD] THEN SET_TAC[]);

Theorem EQUIINTEGRABLE_REFLECT :
    !(fs :(real->real)->bool) a b.
        fs equiintegrable_on interval[a,b]
        ==> {(\x. f(-x)) | f IN fs} equiintegrable_on interval[-b,-a]
Proof
  REPEAT GEN_TAC THEN REWRITE_TAC[equiintegrable_on] THEN
  SIMP_TAC std_ss [RIGHT_FORALL_IMP_THM, IMP_CONJ, FORALL_IN_GSPEC] THEN
  DISCH_TAC THEN DISCH_TAC THEN
  ASM_SIMP_TAC std_ss [INTEGRABLE_REFLECT, INTEGRAL_REFLECT] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``e:real``) THEN ASM_REWRITE_TAC[] THEN
  POP_ASSUM MP_TAC THEN POP_ASSUM K_TAC THEN DISCH_TAC THEN
  DISCH_THEN(X_CHOOSE_THEN ``d:real->real->bool`` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC ``\x. IMAGE (\x. -x) ((d:real->real->bool) (-x))`` THEN
  CONJ_TAC THENL
   [UNDISCH_TAC ``gauge d`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [gauge_def]) THEN
    SIMP_TAC std_ss [gauge_def, OPEN_NEGATIONS] THEN DISCH_TAC THEN
    GEN_TAC THEN GEN_REWR_TAC LAND_CONV [GSYM REAL_NEG_NEG] THEN
    ASM_SIMP_TAC std_ss [FUN_IN_IMAGE],
    ALL_TAC] THEN
  X_GEN_TAC ``f:real->real`` THEN DISCH_TAC THEN
  X_GEN_TAC ``p:real#(real->bool)->bool`` THEN REPEAT DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``f:real->real``) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(MP_TAC o SPEC
   ``IMAGE (\(x,k). (-x:real,IMAGE (\x. -x) (k:real->bool))) p``) THEN
  KNOW_TAC ``IMAGE (\(x,k). (-x,IMAGE (\x. -x) k)) p tagged_division_of
             interval [(a,b)]`` THENL
  [ (* goal 1 (of 2) *)
    UNDISCH_TAC ``p tagged_division_of interval [(-b,-a)]`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [TAGGED_DIVISION_OF]) THEN
    REWRITE_TAC[TAGGED_DIVISION_OF] THEN
    STRIP_TAC THEN ASM_SIMP_TAC std_ss [IMAGE_FINITE] THEN
    SIMP_TAC std_ss [RIGHT_FORALL_IMP_THM, IMP_CONJ, lemma] THEN
    REPEAT CONJ_TAC THENL (* 3 subgoals *)
    [ (* goal 1.1 (of 3) *)
      MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN DISCH_TAC THEN
      ASM_SIMP_TAC std_ss [FUN_IN_IMAGE] THEN CONJ_TAC THENL
       [SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_IMAGE] THEN
        ONCE_REWRITE_TAC[GSYM IN_INTERVAL_REFLECT] THEN
        ASM_SIMP_TAC std_ss [REAL_NEG_NEG, GSYM SUBSET_DEF] THEN ASM_MESON_TAC[],
        SIMP_TAC std_ss [EXTENSION, IN_IMAGE] THEN
        REWRITE_TAC[REAL_ARITH ``(x:real = -y) <=> (-x = y)``] THEN
        ONCE_REWRITE_TAC[GSYM IN_INTERVAL_REFLECT] THEN
        SIMP_TAC std_ss [UNWIND_THM1] THEN
        SUBGOAL_THEN ``?u v:real. k = interval[u,v]``
         (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC)
        THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF], ALL_TAC] THEN
        ASM_MESON_TAC[REAL_NEG_NEG]],
      (* goal 1.2 (of 3) *)
      MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN DISCH_TAC THEN
      MAP_EVERY X_GEN_TAC [``y:real``, ``l:real->bool``] THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPECL
       [``x:real``, ``k:real->bool``,
        ``y:real``, ``l:real->bool``]) THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_IMP THEN
      CONJ_TAC THENL [MESON_TAC[PAIR_EQ], ALL_TAC] THEN
      SIMP_TAC std_ss [INTERIOR_NEGATIONS] THEN
      MATCH_MP_TAC(SET_RULE
       ``(!x. f(f x) = x)
        ==> (s INTER t = {}) ==> (IMAGE f s INTER IMAGE f t = {})``) THEN
      SIMP_TAC std_ss [REAL_NEG_NEG],
      (* goal 1.3 (of 3) *)
      GEN_REWR_TAC I [EXTENSION] THEN
      ONCE_REWRITE_TAC[GSYM IN_INTERVAL_REFLECT] THEN
      FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN X_GEN_TAC ``y:real`` THEN
      SIMP_TAC std_ss [IN_BIGUNION, GSPECIFICATION] THEN
      KNOW_TAC ``(? (s :real -> bool). ( \s.
            (y :real) IN s /\ ?(x :real). (x,s) IN
         IMAGE ( \ ((x :real),(k :real -> bool)). (-x,IMAGE (\ (x :real). -x) k))
           (p :real # (real -> bool) -> bool)) s) <=>
       ? (s :real -> bool). ( \s. -y IN s /\ ? (x :real). (x,s) IN p) s`` THENL
      [ALL_TAC, METIS_TAC []] THEN
      MATCH_MP_TAC(MESON[]
       ``!f. (!x. f(f x) = x) /\ (!x. P x <=> Q(f x))
            ==> ((?x. P x) <=> (?x. Q x))``) THEN SIMP_TAC std_ss [] THEN
      EXISTS_TAC ``IMAGE ((\x. -x):real->real)`` THEN CONJ_TAC THENL
       [SIMP_TAC std_ss [GSYM IMAGE_COMPOSE, o_DEF, REAL_NEG_NEG, IMAGE_ID],
        ALL_TAC] THEN
      X_GEN_TAC ``t:real->bool`` THEN BINOP_TAC THENL
      [ SIMP_TAC std_ss [IN_IMAGE, EXISTS_PROD, PAIR_EQ] THEN
        SUBGOAL_THEN ``!k:real->bool. IMAGE (\x. -x) (IMAGE (\x. -x) k) = k``
        MP_TAC THENL
         [SIMP_TAC std_ss [GSYM IMAGE_COMPOSE, o_DEF, REAL_NEG_NEG, IMAGE_ID],
          METIS_TAC[REAL_EQ_NEG]],
        SIMP_TAC std_ss [IN_IMAGE, EXISTS_PROD] THEN EQ_TAC THENL
        [STRIP_TAC THEN
         ASM_SIMP_TAC std_ss [IMAGE_IMAGE, o_DEF, IMAGE_ID, REAL_NEG_NEG] THEN
         METIS_TAC [],
         DISCH_THEN (X_CHOOSE_TAC ``x:real``) THEN
         EXISTS_TAC ``x:real`` THEN
         EXISTS_TAC ``IMAGE (\x:real. -x) t`` THEN
         ASM_SIMP_TAC std_ss [IMAGE_IMAGE, o_DEF, IMAGE_ID,
                              REAL_NEG_NEG] ] ] ],
    (* goal 2 (of 2) *)
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    KNOW_TAC ``(d :real -> real -> bool) FINE
      IMAGE (\ ((x :real),(k :real -> bool)). (-x,IMAGE (\ (x :real). -x) k))
       (p :real # (real -> bool) -> bool)`` THENL
     [FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [FINE]) THEN
      SIMP_TAC std_ss [FINE, lemma] THEN
      DISCH_TAC THEN X_GEN_TAC ``x:real`` THEN X_GEN_TAC ``k:real->bool`` THEN
      POP_ASSUM (MP_TAC o SPECL [``x:real``, ``k:real->bool``]) THEN
      MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
      MATCH_MP_TAC(SET_RULE
       ``(!x. f(f x) = x) ==> k SUBSET IMAGE f s ==> IMAGE f k SUBSET s``) THEN
      SIMP_TAC std_ss [REAL_NEG_NEG],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    MATCH_MP_TAC(REAL_ARITH
     ``(x:real = y) ==> abs(x - i) < e ==> abs(y - i) < e``) THEN
    W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o lhs o snd) THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN
    ASM_SIMP_TAC std_ss [] THEN
    KNOW_TAC ``(!(x :real # (real -> bool)) (y :real # (real -> bool)).
    x IN (p :real # (real -> bool) -> bool) /\ y IN p /\
    ((\ ((x :real),(k :real -> bool)). (-x,IMAGE (\ (x :real). -x) k)) x =
     (\ ((x :real),(k :real -> bool)). (-x,IMAGE (\ (x :real). -x) k))
       y) ==> (x = y))`` THENL
     [MATCH_MP_TAC(MESON[]
       ``(!x. f(f x) = x)
        ==> !x y. x IN p /\ y IN p /\ (f x = f y) ==> (x = y)``) THEN
      SIMP_TAC std_ss [FORALL_PROD, GSYM IMAGE_COMPOSE, o_DEF, REAL_NEG_NEG,
                  IMAGE_ID],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
      DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SUM_EQ THEN
      SIMP_TAC std_ss [FORALL_PROD, o_THM] THEN
      MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN DISCH_TAC THEN
      SUBGOAL_THEN ``?u v:real. k = interval[u,v]``
       (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC)
      THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF], ALL_TAC] THEN
      AP_THM_TAC THEN AP_TERM_TAC THEN
      SUBGOAL_THEN ``(\x. -x):real->real = (\x. -(&1) * x + 0)`` SUBST1_TAC
      THENL [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC, ALL_TAC] THEN
      SIMP_TAC std_ss [CONTENT_IMAGE_AFFINITY_INTERVAL, ABS_NEG] THEN
      SIMP_TAC std_ss [POW_1, REAL_MUL_LID, ABS_N]] ]
QED

(* ------------------------------------------------------------------------- *)
(* Some technical lemmas about minimizing a "flat" part of a sum over a      *)
(* division, followed by subinterval resictions for equiintegrable family.   *)
(* ------------------------------------------------------------------------- *)

val lemma0 = prove (
   ``!k:real->bool.
          content k / (interval_upperbound k - interval_lowerbound k) =
              if content k = &0 then &0
              else &1:real``,
    REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
    ASM_REWRITE_TAC[real_div, REAL_MUL_LZERO] THEN
    REWRITE_TAC[content] THEN
    COND_CASES_TAC THENL [ASM_MESON_TAC[CONTENT_EMPTY], ALL_TAC] THEN
    UNDISCH_TAC ``~(content(k:real->bool) = &0)`` THEN
    ASM_REWRITE_TAC[content, PRODUCT_EQ_0_NUMSEG] THEN
    ASM_MESON_TAC[REAL_MUL_RINV]);

val lemma1 = prove (
   ``!d a b:real s.
          d division_of s /\ s SUBSET interval[a,b] /\
          ((!k. k IN d
                ==> ~(content k = &0) /\ ~(k INTER {x | x = a} = {})) \/
           (!k. k IN d
                ==> ~(content k = &0) /\ ~(k INTER {x | x = b} = {})))
          ==> (b - a) *
              sum d (\k. content k /
                         (interval_upperbound k - interval_lowerbound k))
              <= content(interval[a,b])``,
    REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
    ABBREV_TAC ``extend = (\k:real->bool. interval [a, b:real])`` THEN
    SUBGOAL_THEN ``!k. k IN d ==> k SUBSET interval[a:real,b]``
    ASSUME_TAC THENL
     [RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM_SET_TAC[],
      ALL_TAC] THEN
    SUBGOAL_THEN ``!k:real->bool. k IN d ==> ~(k = {})`` ASSUME_TAC THENL
     [ASM_MESON_TAC[division_of], ALL_TAC] THEN
    SUBGOAL_THEN
     ``(!k. k IN d ==> ~((extend:(real->bool)->(real->bool)) k = {})) /\
       (!k. k IN d ==> (extend k) SUBSET interval[a,b])``
    STRIP_ASSUME_TAC THENL
     [FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
      CONJ_TAC THEN MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN
      (DISCH_TAC THEN EXPAND_TAC "extend" THEN
       SUBGOAL_THEN ``interval[u:real,v] SUBSET interval[a,b]`` MP_TAC THENL
        [ASM_SIMP_TAC std_ss [], ALL_TAC] THEN
       SUBGOAL_THEN ``~(interval[u:real,v] = {})`` MP_TAC THENL
        [ASM_SIMP_TAC std_ss [], ALL_TAC] THEN
       SIMP_TAC std_ss [SUBSET_INTERVAL, INTERVAL_NE_EMPTY,
                INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND] THEN
       METIS_TAC[REAL_LE_TRANS, REAL_LE_REFL]),
      ALL_TAC] THEN
    SUBGOAL_THEN
     ``!k1 k2. k1 IN d /\ k2 IN d /\ ~(k1 = k2)
              ==> (interior((extend:(real->bool)->(real->bool)) k1) INTER
                   interior(extend k2) = {})``
    ASSUME_TAC THENL
    [ (* goal 1 (of 2) *)
      SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
      FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
      MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN DISCH_TAC THEN
      MAP_EVERY X_GEN_TAC [``w:real``, ``z:real``] THEN DISCH_TAC THEN
      DISCH_TAC THEN
      UNDISCH_TAC ``d division_of s`` THEN DISCH_TAC THEN
      FIRST_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
      DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
      DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
      DISCH_THEN (CONJUNCTS_THEN2 MP_TAC K_TAC) THEN
      DISCH_THEN(MP_TAC o SPECL
       [``interval[u:real,v]``, ``interval[w:real,z]``]) THEN
      ASM_REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN
      ONCE_REWRITE_TAC[MONO_NOT_EQ] THEN
      REWRITE_TAC[GSYM MEMBER_NOT_EMPTY, IN_INTER] THEN
      EXPAND_TAC "extend" THEN
      SIMP_TAC std_ss [INTERIOR_CLOSED_INTERVAL, IN_INTERVAL] THEN
      SUBGOAL_THEN ``~(interval[u:real,v] = {}) /\
                     ~(interval[w:real,z] = {})``
      MP_TAC THENL [ASM_SIMP_TAC std_ss [], ALL_TAC] THEN
      SIMP_TAC std_ss [SUBSET_INTERVAL, INTERVAL_NE_EMPTY,
               INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND] THEN
      STRIP_TAC THEN DISCH_THEN(X_CHOOSE_THEN ``x:real`` MP_TAC) THEN
      MP_TAC(MESON[]
       ``(!P. (!j:num. P j) <=> P i /\ (!j. ~(j = i) ==> P j))``) THEN
      DISCH_THEN(fn th => GEN_REWR_TAC
       (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN
      ASM_SIMP_TAC std_ss [AND_IMP_INTRO] THEN STRIP_TAC THEN
      UNDISCH_TAC ``(!k. k IN d ==> content k <> 0 /\ k INTER {x | x = a} <> {}) \/
                     !k. k IN d ==> content k <> 0 /\ k INTER {x | x = b} <> {}`` THEN
      DISCH_TAC THEN
      FIRST_X_ASSUM(DISJ_CASES_THEN
       (fn th => MP_TAC(SPEC ``interval[u:real,v]`` th) THEN
                  MP_TAC(SPEC ``interval[w:real,z]`` th))) THEN
      ASM_SIMP_TAC std_ss [CONTENT_EQ_0_INTERIOR, INTERIOR_CLOSED_INTERVAL] THEN
      REWRITE_TAC [IMP_CONJ, GSYM MEMBER_NOT_EMPTY, IN_INTER] THEN
      SIMP_TAC std_ss [IN_INTERVAL, LEFT_IMP_EXISTS_THM] THEN
      X_GEN_TAC ``q:real`` THEN STRIP_TAC THEN
      X_GEN_TAC ``r:real`` THEN STRIP_TAC THEN
      X_GEN_TAC ``s':real`` THEN STRIP_TAC THEN
      X_GEN_TAC ``t:real`` THEN STRIP_TAC THEN
      FULL_SIMP_TAC std_ss [GSPECIFICATION] THENL
       [EXISTS_TAC ``min ((q:real)) ((s':real))``,
        EXISTS_TAC ``max ((q:real)) ((s':real))``] THEN
      (SUBGOAL_THEN ``interval[u:real,v] SUBSET interval[a,b] /\
                      interval[w:real,z] SUBSET interval[a,b]``
       MP_TAC THENL [ASM_SIMP_TAC std_ss [], ALL_TAC] THEN
       SUBGOAL_THEN ``~(interval[u:real,v] = {}) /\
                      ~(interval[w:real,z] = {})``
       MP_TAC THENL [ASM_SIMP_TAC std_ss [], ALL_TAC] THEN
       ASM_SIMP_TAC std_ss [INTERVAL_NE_EMPTY, SUBSET_INTERVAL] THEN
       rpt STRIP_TAC >> RW_TAC real_ss [min_def, max_def] THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       REAL_ARITH_TAC),
      ALL_TAC] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
     ``sum (IMAGE (extend:(real->bool)->(real->bool)) d) content`` THEN
    CONJ_TAC THENL
     [W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE_NONZERO o rand o snd) THEN
      KNOW_TAC ``FINITE (d :(real -> bool) -> bool) /\
        (!(x :real -> bool) (y :real -> bool).
           x IN d /\ y IN d /\ x <> y /\
          ((extend :(real -> bool) -> real -> bool) x = extend y) ==>
           (content (extend x) = (0 :real)))`` THENL
       [ASM_REWRITE_TAC[] THEN
        MAP_EVERY X_GEN_TAC [``k1:real->bool``, ``k2:real->bool``] THEN
        STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
         [``k1:real->bool``, ``k2:real->bool``]) THEN
        ASM_REWRITE_TAC[INTER_IDEMPOT] THEN
        EXPAND_TAC "extend" THEN REWRITE_TAC[CONTENT_EQ_0_INTERIOR],
        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
        DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN
        MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC std_ss [] THEN
        FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
        MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN DISCH_TAC THEN
        ASM_CASES_TAC ``content(interval[u:real,v]) = &0`` THENL
         [ASM_REWRITE_TAC[real_div, REAL_MUL_LZERO, REAL_MUL_RZERO, o_THM] THEN
          EXPAND_TAC "extend" THEN REWRITE_TAC[CONTENT_POS_LE],
          ALL_TAC] THEN
        FIRST_ASSUM(MP_TAC o REWRITE_RULE [GSYM CONTENT_LT_NZ]) THEN
        DISCH_THEN(fn th => ASSUME_TAC th THEN MP_TAC th) THEN
        REWRITE_TAC[CONTENT_POS_LT_EQ] THEN STRIP_TAC THEN
        ASM_SIMP_TAC std_ss [INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND,
                     REAL_LT_IMP_LE, real_div, REAL_MUL_ASSOC] THEN
        ASM_SIMP_TAC std_ss [GSYM real_div, REAL_LE_LDIV_EQ, REAL_SUB_LT] THEN
        SUBGOAL_THEN
         ``~((extend:(real->bool)->(real->bool)) (interval[u,v]) = {})``
        MP_TAC THENL [ASM_SIMP_TAC std_ss [], ALL_TAC] THEN
        EXPAND_TAC "extend" THEN ASM_SIMP_TAC std_ss [content, o_THM] THEN
        ASM_SIMP_TAC std_ss [INTERVAL_NE_EMPTY, INTERVAL_LOWERBOUND,
                     INTERVAL_UPPERBOUND, REAL_LT_IMP_LE] THEN
        DISCH_THEN(K ALL_TAC) THEN REAL_ARITH_TAC],
      MATCH_MP_TAC SUBADDITIVE_CONTENT_DIVISION THEN EXISTS_TAC
       ``BIGUNION (IMAGE (extend:(real->bool)->(real->bool)) d)`` THEN
      ASM_SIMP_TAC std_ss [BIGUNION_SUBSET, division_of, IMAGE_FINITE] THEN
      SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM, FORALL_IN_IMAGE] THEN
      FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
      REPEAT CONJ_TAC THEN MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN
      DISCH_TAC THENL
       [CONJ_TAC THENL [ASM_SET_TAC[], ASM_SIMP_TAC std_ss []] THEN
        EXPAND_TAC "extend" THEN SIMP_TAC std_ss [] THEN MESON_TAC[],
        ASM_MESON_TAC[],
        ASM_SIMP_TAC std_ss []]]);

Theorem SUM_CONTENT_AREA_OVER_THIN_DIVISION :
    !d a b:real s c.
        d division_of s /\ s SUBSET interval[a,b] /\
                 a <= c /\ c <= b /\
        (!k. k IN d ==> ~(k INTER {x | x = c} = {}))
        ==> (b - a) *
            sum d (\k. content k /
                       (interval_upperbound k - interval_lowerbound k))
            <= &2 * content(interval[a,b])
Proof
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC ``content(interval[a:real,b]) = &0`` THENL
   [MATCH_MP_TAC(REAL_ARITH ``(x = &0) /\ &0 <= y ==> x <= &2 * y:real``) THEN
    SIMP_TAC std_ss [CONTENT_POS_LE, REAL_ENTIRE] THEN DISJ2_TAC THEN
    MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC ``k:real->bool`` THEN
    DISCH_TAC THEN SIMP_TAC std_ss [real_div, REAL_ENTIRE] THEN DISJ1_TAC THEN
    MATCH_MP_TAC CONTENT_0_SUBSET THEN
    MAP_EVERY EXISTS_TAC [``a:real``, ``b:real``] THEN
    METIS_TAC[division_of, SUBSET_TRANS],
    ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o REWRITE_RULE [GSYM CONTENT_LT_NZ]) THEN
  DISCH_THEN(fn th => ASSUME_TAC th THEN MP_TAC th) THEN
  REWRITE_TAC[CONTENT_POS_LT_EQ] THEN STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
  MP_TAC(ISPECL
   [``{k | k IN {l INTER {x | x <= c} | l |
                l IN d /\ ~(l INTER {x:real | x <= c} = {})} /\
          ~(content k = &0)}``,
    ``a:real``, ``c:real``,
    ``BIGUNION {k | k IN {l INTER {x | x <= c} | l |
                       l IN d /\ ~(l INTER {x:real | x <= c} = {})} /\
                 ~(content k = &0)}``] lemma1) THEN
  MP_TAC(ISPECL
   [``{k | k IN {l INTER {x | x >= c} | l |
                l IN d /\ ~(l INTER {x:real | x >= c} = {})} /\
          ~(content k = &0)}``,
    ``c:real``, ``b:real``,
    ``BIGUNION {k | k IN {l INTER {x | x >= c} | l |
                       l IN d /\ ~(l INTER {x:real | x >= c} = {})} /\
                 ~(content k = &0)}``] lemma1) THEN
  ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC(TAUT
   `(p1 /\ p2) /\ (q1 /\ q2 ==> r) ==> (p2 ==> q2) ==> (p1 ==> q1) ==> r`) THEN
  CONJ_TAC THENL
  [ (* goal 1 (of 2) *)
    CONJ_TAC THENL
    [ (* goal 1.1 (of 2) *)
      REPEAT CONJ_TAC THENL (* 3 subgoals *)
      [ (* goal 1.1.1 (of 3) *)
        REWRITE_TAC[division_of] THEN CONJ_TAC THENL (* 2 subgoals *)
        [ (* goal 1.1.1.1 (of 2) *)
          ONCE_REWRITE_TAC [METIS []
         ``{k | k IN
          {l INTER {x | x <= c} | l | l IN d /\ l INTER {x | x <= c} <> {}} /\
            content k <> 0} =
           {k | k IN
          {l INTER {x | x <= c} | l | l IN d /\ l INTER {x | x <= c} <> {}} /\
            (\k. content k <> 0) k}``] THEN
          MATCH_MP_TAC FINITE_RESTRICT THEN
          KNOW_TAC ``FINITE (IMAGE (\l. l INTER {x | x <= c:real})
                   {l | l IN d /\ ~(l INTER {x | x <= c} = {})})`` THENL
          [ALL_TAC, METIS_TAC [SIMPLE_IMAGE_GEN]] THEN
          MATCH_MP_TAC IMAGE_FINITE THEN METIS_TAC [FINITE_RESTRICT],
          (* goal 1.1.1.2 (of 2) *)
          ALL_TAC] THEN
        SIMP_TAC std_ss [FORALL_IN_GSPEC, IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
        CONJ_TAC THENL (* 2 subgoals *)
        [ (* goal 1.1.1.1 (of 2) *)
          FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
          MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN
          REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
          [ SIMP_TAC std_ss [GSPECIFICATION, SUBSET_DEF, IN_BIGUNION] THEN ASM_MESON_TAC[],
            ASM_SIMP_TAC std_ss [INTERVAL_SPLIT] THEN MESON_TAC[] ],
          (* goal 1.1.1.2 (of 2) *)
          X_GEN_TAC ``k:real->bool`` THEN REPEAT DISCH_TAC THEN
          X_GEN_TAC ``l:real->bool`` THEN REPEAT DISCH_TAC THEN
          UNDISCH_TAC ``d division_of s`` THEN DISCH_TAC THEN
          FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
          DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
          DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
          DISCH_THEN (CONJUNCTS_THEN2 MP_TAC K_TAC) THEN
          DISCH_THEN(MP_TAC o SPECL [``k:real->bool``, ``l:real->bool``]) THEN
          KNOW_TAC ``k IN d /\ l IN d /\ k <> l:real->bool`` THENL
          [ASM_MESON_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
          MATCH_MP_TAC(SET_RULE
         ``s SUBSET s' /\ t SUBSET t'
          ==> (s' INTER t' = {}) ==> (s INTER t = {})``) THEN
          CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[] ],
        (* goal 1.1.2 (of 3) *)
        SIMP_TAC std_ss [BIGUNION_SUBSET, FORALL_IN_GSPEC, IMP_CONJ] THEN
        X_GEN_TAC ``k:real->bool`` THEN REPEAT DISCH_TAC THEN
        SUBGOAL_THEN ``k SUBSET interval[a:real,b]`` MP_TAC THENL
        [ASM_MESON_TAC[division_of, SUBSET_TRANS], ALL_TAC] THEN
        MATCH_MP_TAC(SET_RULE
       ``i INTER h SUBSET j ==> k SUBSET i ==> k INTER h SUBSET j``) THEN
        ASM_SIMP_TAC std_ss [INTERVAL_SPLIT, SUBSET_INTERVAL] THEN
        RW_TAC real_ss [REAL_LE_MIN, REAL_LE_REFL],
        (* goal 1.1.3 (of 3) *)
        ALL_TAC ],
      (* goal 1.2 (of 2) *)
      REPEAT CONJ_TAC THENL
      [ (* goal 1.2.1 (of 3) *)
        REWRITE_TAC[division_of] THEN CONJ_TAC THENL
        [ (* goal 1.2.1.1 (of 2) *)
          ONCE_REWRITE_TAC [METIS []
         ``{k | k IN
          {l INTER {x | x >= c} | l | l IN d /\ l INTER {x | x >= c} <> {}} /\
            content k <> 0} =
           {k | k IN
          {l INTER {x | x >= c} | l | l IN d /\ l INTER {x | x >= c} <> {}} /\
            (\k. content k <> 0) k}``] THEN
          MATCH_MP_TAC FINITE_RESTRICT THEN
          KNOW_TAC ``FINITE (IMAGE (\l. l INTER {x | x >= c:real})
                   {l | l IN d /\ ~(l INTER {x | x >= c} = {})})`` THENL
          [ALL_TAC, METIS_TAC [SIMPLE_IMAGE_GEN]] THEN
          MATCH_MP_TAC IMAGE_FINITE THEN METIS_TAC [FINITE_RESTRICT],
          (* goal 1.2.1.2 (of 2) *)
          ALL_TAC ] THEN
        SIMP_TAC std_ss [FORALL_IN_GSPEC, IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
        CONJ_TAC THENL
        [ (* goal 1.2.1.1 (of 2) *)
          FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
          MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN
          REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
          [SIMP_TAC std_ss [GSPECIFICATION, SUBSET_DEF, IN_BIGUNION] THEN ASM_MESON_TAC[],
          ASM_SIMP_TAC std_ss [INTERVAL_SPLIT] THEN MESON_TAC[]],
          (* goal 1.2.1.2 (of 2) *)
          X_GEN_TAC ``k:real->bool`` THEN REPEAT DISCH_TAC THEN
          X_GEN_TAC ``l:real->bool`` THEN REPEAT DISCH_TAC THEN
          UNDISCH_TAC ``d division_of s`` THEN DISCH_TAC THEN
          FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
          DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
          DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
          DISCH_THEN (CONJUNCTS_THEN2 MP_TAC K_TAC) THEN
          DISCH_THEN(MP_TAC o SPECL [``k:real->bool``, ``l:real->bool``]) THEN
          KNOW_TAC ``k IN d /\ l IN d /\ k <> l:real->bool`` THENL
          [ASM_MESON_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
          MATCH_MP_TAC(SET_RULE
         ``s SUBSET s' /\ t SUBSET t'
          ==> (s' INTER t' = {}) ==> (s INTER t = {})``) THEN
          CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[] ],
       (* goal 1.2.2 (of 3) *)
       SIMP_TAC std_ss [BIGUNION_SUBSET, FORALL_IN_GSPEC, IMP_CONJ] THEN
       X_GEN_TAC ``k:real->bool`` THEN REPEAT DISCH_TAC THEN
       SUBGOAL_THEN ``k SUBSET interval[a:real,b]`` MP_TAC THENL
       [ASM_MESON_TAC[division_of, SUBSET_TRANS], ALL_TAC] THEN
       MATCH_MP_TAC(SET_RULE
       ``i INTER h SUBSET j ==> k SUBSET i ==> k INTER h SUBSET j``) THEN
       ASM_SIMP_TAC std_ss [INTERVAL_SPLIT, SUBSET_INTERVAL] THEN
       RW_TAC real_ss [REAL_LE_MAX, REAL_LE_REFL],
       (* goal 1.2.3 (of 3) *)
       ALL_TAC ] ] THENL [DISJ2_TAC, DISJ1_TAC] THEN
    (* still in goal 1 *)
    SIMP_TAC std_ss [FORALL_IN_GSPEC, IMP_CONJ] THEN
    ASM_SIMP_TAC std_ss [real_ge] THEN X_GEN_TAC ``l:real->bool`` THEN
    DISCH_TAC THEN FIRST_ASSUM (MP_TAC o SPEC ``l:real->bool``) THEN
    FIRST_ASSUM (fn th => REWRITE_TAC [th]) THEN
    SIMP_TAC std_ss [IN_INTER, NOT_IN_EMPTY, EXTENSION, GSPECIFICATION] THEN
    SIMP_TAC std_ss [REAL_LE_REFL],
    (* goal 2 (of 2) *)
    ASM_SIMP_TAC std_ss [] ] THEN
 (* stage work *)
  SUBGOAL_THEN
  ``(sum {k | k IN
             { l INTER {x | x <= c} | l |
               l IN d /\ ~(l INTER {x:real | x <= c} = {})} /\
             ~(content k = &0)}
        (\k. content k /
             (interval_upperbound k - interval_lowerbound k)) =
     sum d ((\k. content k /
             (interval_upperbound k - interval_lowerbound k)) o
           (\k. k INTER {x | x <= c}))) /\
    (sum {k | k IN
             { l INTER {x | x >= c} | l |
               l IN d /\ ~(l INTER {x:real | x >= c} = {})} /\
             ~(content k = &0)}
        (\k. content k /
             (interval_upperbound k - interval_lowerbound k)) =
     sum d ((\k. content k /
             (interval_upperbound k - interval_lowerbound k)) o
           (\k. k INTER {x | x >= c})))``
  (CONJUNCTS_THEN SUBST1_TAC) THENL
  [ (* goal 1 (of 2) *)
    CONJ_TAC THENL
    [ (* goal 1.1 (of 2) *)
      W(MP_TAC o PART_MATCH (rand o rand) SUM_IMAGE_NONZERO o rand o snd) THEN
      ASM_SIMP_TAC std_ss [] THEN
      KNOW_TAC ``(!(x :real -> bool) (y :real -> bool).
       x IN (d :(real -> bool) -> bool) /\ y IN d /\ x <> y /\
      (x INTER {x | x <= (c :real)} = y INTER {x | x <= c}) ==>
      (content (y INTER {x | x <= c}) /
       (interval_upperbound (y INTER {x | x <= c}) -
        interval_lowerbound (y INTER {x | x <= c})) = (0 : real)))`` THENL
      [ MAP_EVERY X_GEN_TAC [``k:real->bool``, ``l:real->bool``] THEN
        STRIP_TAC THEN
        SIMP_TAC std_ss [real_div, REAL_ENTIRE] THEN DISJ1_TAC THEN
        (MATCH_MP_TAC DIVISION_SPLIT_LEFT_INJ ORELSE
         MATCH_MP_TAC DIVISION_SPLIT_RIGHT_INJ) THEN METIS_TAC[],
        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
        DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN
        MATCH_MP_TAC SUM_SUPERSET THEN CONJ_TAC THENL [SET_TAC[], ALL_TAC] THEN
        GEN_TAC THEN DISCH_TAC THEN
        KNOW_TAC ``((!l:real->bool. (l INTER {x | x <= c} = {})
                        ==> (content ((\k. k INTER {x | x <= c}) l) = &0))
                        ==> (content x = &0))
        ==> ((\k. content k / (interval_upperbound k -
                               interval_lowerbound k)) x = &0)`` THENL
        [ALL_TAC, POP_ASSUM MP_TAC THEN SET_TAC []] THEN
        SIMP_TAC std_ss [CONTENT_EMPTY, real_div, REAL_MUL_LZERO] ],
       (* goal 1.2 (of 2) *)
       W(MP_TAC o PART_MATCH (rand o rand) SUM_IMAGE_NONZERO o rand o snd) THEN
       ASM_SIMP_TAC std_ss [] THEN
       KNOW_TAC ``(!(x :real -> bool) (y :real -> bool).
       x IN (d :(real -> bool) -> bool) /\ y IN d /\ x <> y /\
      (x INTER {x | x >= (c :real)} = y INTER {x | x >= c}) ==>
      (content (y INTER {x | x >= c}) /
       (interval_upperbound (y INTER {x | x >= c}) -
        interval_lowerbound (y INTER {x | x >= c})) = (0 : real)))`` THENL
       [ MAP_EVERY X_GEN_TAC [``k:real->bool``, ``l:real->bool``] THEN
         STRIP_TAC THEN
         SIMP_TAC std_ss [real_div, REAL_ENTIRE] THEN DISJ1_TAC THEN
         (MATCH_MP_TAC DIVISION_SPLIT_LEFT_INJ ORELSE
          MATCH_MP_TAC DIVISION_SPLIT_RIGHT_INJ) THEN METIS_TAC[],
         DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
         DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN
         MATCH_MP_TAC SUM_SUPERSET THEN CONJ_TAC THENL [SET_TAC[], ALL_TAC] THEN
         GEN_TAC THEN DISCH_TAC THEN
         KNOW_TAC ``((!l:real->bool. (l INTER {x | x >= c} = {})
                        ==> (content ((\k. k INTER {x | x >= c}) l) = &0))
                        ==> (content x = &0))
        ==> ((\k. content k / (interval_upperbound k -
                               interval_lowerbound k)) x = &0)`` THENL
         [ALL_TAC, POP_ASSUM MP_TAC THEN SET_TAC []] THEN
         SIMP_TAC std_ss [CONTENT_EMPTY, real_div, REAL_MUL_LZERO]] ],
     (* goal 2 (of 2) *)
     ALL_TAC] THEN
  ASM_CASES_TAC ``c = a:real`` THENL
  [ASM_SIMP_TAC std_ss [REAL_SUB_REFL, REAL_MUL_LZERO, CONTENT_POS_LE] THEN
   MATCH_MP_TAC(REAL_ARITH ``(x = y) /\ a <= b ==> x <= a ==> y <= b:real``) THEN
      CONJ_TAC THENL
       [AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN
        X_GEN_TAC ``k:real->bool`` THEN DISCH_TAC THEN
        PURE_REWRITE_TAC[o_THM] THEN AP_TERM_TAC THEN
        SIMP_TAC std_ss [real_ge] THEN
        ONCE_REWRITE_TAC [METIS [] ``({x | a <= x} = {x | (\x. a <= x) (x:real)}) /\
                                     ({x | x <= a} = {x | (\x. x <= a) (x:real)})``] THEN
        SIMP_TAC std_ss [SET_RULE
         ``(k INTER {x | P x} = k) <=> (!x. x IN k ==> P x)``] THEN
        X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
        SUBGOAL_THEN ``x IN interval[a:real,b]`` MP_TAC THENL
         [ASM_MESON_TAC[SUBSET_DEF, division_of], ALL_TAC] THEN
        ASM_SIMP_TAC std_ss [IN_INTERVAL],
        MATCH_MP_TAC(REAL_ARITH ``&0 <= y /\ x <= y ==> x <= &2 * y:real``) THEN
        REWRITE_TAC[CONTENT_POS_LE] THEN MATCH_MP_TAC CONTENT_SUBSET THEN
        SIMP_TAC std_ss [SUBSET_INTERVAL] THEN MESON_TAC[REAL_LE_REFL]],
      ALL_TAC] THEN
  ASM_CASES_TAC ``c = b:real`` THENL
  [ASM_SIMP_TAC std_ss [REAL_SUB_REFL, REAL_MUL_LZERO, CONTENT_POS_LE] THEN
   MATCH_MP_TAC(REAL_ARITH ``(x = y) /\ a <= b ==> x <= a ==> y <= b:real``) THEN
      CONJ_TAC THENL
       [AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN
        X_GEN_TAC ``k:real->bool`` THEN DISCH_TAC THEN
        PURE_REWRITE_TAC[o_THM] THEN AP_TERM_TAC THEN
        SIMP_TAC std_ss [real_ge] THEN
        ONCE_REWRITE_TAC [METIS [] ``({x | a <= x} = {x | (\x. a <= x) (x:real)}) /\
                                     ({x | x <= a} = {x | (\x. x <= a) (x:real)})``] THEN
        SIMP_TAC std_ss [SET_RULE
         ``(k INTER {x | P x} = k) <=> (!x. x IN k ==> P x)``] THEN
        X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
        SUBGOAL_THEN ``x IN interval[a:real,b]`` MP_TAC THENL
         [ASM_MESON_TAC[SUBSET_DEF, division_of], ALL_TAC] THEN
        ASM_SIMP_TAC std_ss [IN_INTERVAL],
        MATCH_MP_TAC(REAL_ARITH ``&0 <= y /\ x <= y ==> x <= &2 * y:real``) THEN
        REWRITE_TAC[CONTENT_POS_LE] THEN MATCH_MP_TAC CONTENT_SUBSET THEN
        SIMP_TAC std_ss [SUBSET_INTERVAL] THEN MESON_TAC[REAL_LE_REFL]],
      ALL_TAC] THEN
  SUBGOAL_THEN ``(a:real) < c /\ c < (b:real)`` STRIP_ASSUME_TAC THENL
   [FULL_SIMP_TAC real_ss [REAL_LE_LT], ALL_TAC] THEN
  ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
  ASM_SIMP_TAC real_ss [GSYM REAL_LE_RDIV_EQ, REAL_SUB_LT] THEN
  REWRITE_TAC[real_div, REAL_ARITH ``x * &2 * inv y = &2 * x * inv y:real``] THEN
  REWRITE_TAC [GSYM real_div, GSYM REAL_MUL_ASSOC] THEN
  MATCH_MP_TAC(REAL_ARITH
   ``s <= s1 + s2 /\ (c1 = c) /\ (c2 = c)
    ==> s1 <= c1 /\ s2 <= c2 ==> s <= &2 * c:real``) THEN
  CONJ_TAC THENL
  [ (* goal 1 (of 2) *)
    ASM_SIMP_TAC std_ss [GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN
    ASM_SIMP_TAC std_ss [lemma0] THEN
    FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
    MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN DISCH_TAC THEN
    SUBGOAL_THEN
     ``~(interval[u:real,v] = {}) /\ interval[u,v] SUBSET interval[a,b]``
    MP_TAC THENL [ASM_MESON_TAC[division_of, SUBSET_TRANS], ALL_TAC] THEN
    SIMP_TAC std_ss [INTERVAL_NE_EMPTY, SUBSET_INTERVAL, IMP_CONJ] THEN
    REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN
    Know `!x x1 x2 c c1 c2. &0 <= x:real /\ (c1 + c2 = c:real) /\
      (~(c1 = &0) ==> (x1 = x)) /\ (~(c2 = &0) ==> (x2 = x))
      ==> (if c = &0 then &0 else x) <=
          (if c1 = &0 then &0 else x1) +
          (if c2 = &0 then &0 else x2)`
    >- (KILL_TAC >> rpt GEN_TAC \\
        rpt COND_CASES_TAC >> REAL_ASM_ARITH_TAC) \\
    DISCH_THEN MATCH_MP_TAC \\
    ASM_SIMP_TAC std_ss [GSYM CONTENT_SPLIT, REAL_LE_01],
    SUBGOAL_THEN
    ``~(interval[a,b] = {}) /\
      ~(interval[a:real,c] = {}) /\
      ~(interval[c:real,b] = {})``
    MP_TAC THENL
     [SIMP_TAC std_ss [INTERVAL_NE_EMPTY] THEN
      ASM_MESON_TAC[REAL_LT_IMP_LE, REAL_LE_REFL],
      ALL_TAC] THEN
    SIMP_TAC std_ss [content] THEN
    SIMP_TAC std_ss [INTERVAL_NE_EMPTY, INTERVAL_UPPERBOUND, INTERVAL_LOWERBOUND] THEN
    STRIP_TAC THEN UNDISCH_TAC ``c <> a:real`` THEN
    GEN_REWR_TAC LAND_CONV [REAL_ARITH ``(c <> a) <=> (c - a <> 0:real)``] THEN
    UNDISCH_TAC ``c <> b:real`` THEN
    GEN_REWR_TAC LAND_CONV [REAL_ARITH ``(c <> b) <=> (b - c <> 0:real)``] THEN
    UNDISCH_TAC ``a < b:real`` THEN
    GEN_REWR_TAC LAND_CONV [REAL_ARITH ``(a < b) <=> (0 < b - a:real)``] THEN
    DISCH_THEN (MP_TAC o ONCE_REWRITE_RULE [EQ_SYM_EQ] o MATCH_MP REAL_LT_IMP_NE) THEN
    SIMP_TAC std_ss [REAL_DIV_REFL] ]
QED

Theorem BOUNDED_EQUIINTEGRAL_OVER_THIN_TAGGED_PARTIAL_DIVISION :
  !fs f:real->real a b e.
    fs equiintegrable_on interval[a,b] /\ f IN fs /\
    (!h x. h IN fs /\ x IN interval[a,b] ==> abs(h x) <= abs(f x)) /\
    &0 < e
    ==> ?d. gauge d /\
            !c p h. c IN interval[a,b] /\
                      p tagged_partial_division_of interval[a,b] /\
                      d FINE p /\
                      h IN fs /\
                      (!x k. (x,k) IN p ==> ~(k INTER {x | x = c} = {}))
                      ==> sum p(\(x,k). abs(integral k h)) < e
Proof
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC ``content(interval[a:real,b]) = &0`` THENL
   [EXISTS_TAC ``\x:real. ball(x,&1)`` THEN REWRITE_TAC[GAUGE_TRIVIAL] THEN
    REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
     ``&0 < e ==> (x = &0) ==> x < e:real``)) THEN
    MATCH_MP_TAC SUM_EQ_0 THEN SIMP_TAC std_ss [FORALL_PROD] THEN
    GEN_TAC THEN X_GEN_TAC ``k:real->bool`` THEN DISCH_TAC THEN
    SUBGOAL_THEN
     ``?u v:real. (k = interval[u,v]) /\ interval[u,v] SUBSET interval[a,b]``
    STRIP_ASSUME_TAC THENL
     [METIS_TAC[tagged_partial_division_of], ALL_TAC] THEN
    ASM_REWRITE_TAC[ABS_ZERO] THEN MATCH_MP_TAC INTEGRAL_NULL THEN
    ASM_MESON_TAC[CONTENT_0_SUBSET],
    ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o REWRITE_RULE [GSYM CONTENT_LT_NZ]) THEN
  DISCH_THEN(fn th => ASSUME_TAC th THEN MP_TAC th) THEN
  REWRITE_TAC[CONTENT_POS_LT_EQ] THEN STRIP_TAC THEN
  SUBGOAL_THEN
   ``?d. gauge d /\
        !p h. p tagged_partial_division_of interval [a,b] /\
              d FINE p /\ (h:real->real) IN fs
              ==> sum p (\(x,k). abs(content k * h x - integral k h)) <
                  e / &2``
   (X_CHOOSE_THEN ``g0:real->real->bool`` STRIP_ASSUME_TAC)
  THENL
   [UNDISCH_TAC ``fs equiintegrable_on interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [equiintegrable_on]) THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC
      ``e / &5 / (&1 + &1:real)``)) THEN
    ASM_SIMP_TAC real_ss [REAL_LT_DIV, REAL_ARITH ``&0 < &5:real``,
      METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0] ``&0 < &n + &1:real``] THEN
    DISCH_THEN (X_CHOOSE_TAC ``g:real->real->bool``) THEN
    EXISTS_TAC ``g:real->real->bool`` THEN POP_ASSUM MP_TAC THEN
    STRIP_TAC THEN ASM_SIMP_TAC std_ss [] THEN MAP_EVERY X_GEN_TAC
     [``p:(real#(real->bool))->bool``, ``h:real->real``] THEN
    STRIP_TAC THEN
    MP_TAC(ISPECL [``h:real->real``, ``a:real``, ``b:real``,
           ``g:real->real->bool``, ``e / &5 / ((&1:real) + &1)``]
        HENSTOCK_LEMMA_PART2) THEN
    ASM_SIMP_TAC real_ss [REAL_LT_DIV, REAL_ARITH ``&0 < &5:real``,
      METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0] ``&0 < &n + &1:real``] THEN
    DISCH_THEN(MP_TAC o SPEC ``p:(real#(real->bool))->bool``) THEN
    ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC(REAL_ARITH
     ``a < b ==> x <= a ==> x < b:real``) THEN
    REWRITE_TAC [real_div, REAL_MUL_ASSOC] THEN
    ONCE_REWRITE_TAC [REAL_ARITH ``a * b * c * inv a = (a * inv a) * b * c:real``] THEN
    SIMP_TAC real_ss [REAL_MUL_RINV] THEN REWRITE_TAC [GSYM real_div] THEN
    SIMP_TAC real_ss [REAL_LT_RDIV_EQ] THEN ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN
    REWRITE_TAC [real_div, REAL_MUL_ASSOC] THEN REWRITE_TAC [GSYM real_div] THEN
    SIMP_TAC real_ss [REAL_LT_LDIV_EQ] THEN UNDISCH_TAC ``0 < e:real`` THEN
    REAL_ARITH_TAC,
    ALL_TAC] THEN
  ABBREV_TAC
   ``g:real->real->bool =
       \x. g0(x) INTER
           ball(x,(e / &8 / (abs(f x:real) + &1)) *
                  inf(IMAGE (\m. b - a) ((1:num)..(1:num))) /
                  content(interval[a:real,b]))`` THEN
  SUBGOAL_THEN ``gauge(g:real->real->bool)`` ASSUME_TAC THENL
   [EXPAND_TAC "g" THEN
    KNOW_TAC ``(gauge (\(x :real).
      (g0 :real -> real -> bool) x INTER
      (\x. ball (x, (e :real) / (8 :real) /
         (abs ((f :real -> real) x) + (1 :real)) *
         inf (IMAGE (\(m :num). (b :real) - (a :real))
              ((1 :num) .. (1 :num))) / content (interval [(a,b)]))) x) : bool)`` THENL
    [ALL_TAC, METIS_TAC []] THEN
    MATCH_MP_TAC GAUGE_INTER THEN ASM_REWRITE_TAC[] THEN
    SIMP_TAC std_ss [gauge_def, OPEN_BALL, CENTRE_IN_BALL] THEN
    X_GEN_TAC ``x:real`` THEN
    REWRITE_TAC [real_div, REAL_ARITH ``a * b * c * d * e =
                                       (a *  b * c) * (d * e:real)``] THEN
    MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC [GSYM real_div] THEN
    ASM_SIMP_TAC real_ss [REAL_LT_DIV, REAL_ARITH
     ``&0 < &8:real /\ &0 < abs(x:real) + &1:real``] THEN
    MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC [NUMSEG_SING, IMAGE_SING, INF_SING] THEN
    UNDISCH_TAC ``a < b:real`` THEN REAL_ARITH_TAC,
    ALL_TAC] THEN
  EXISTS_TAC ``g:real->real->bool`` THEN ASM_REWRITE_TAC[] THEN
  MAP_EVERY X_GEN_TAC
   [``c:real``, ``p:(real#(real->bool))->bool``,
    ``h:real->real``] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN
   ``interval[c:real,b] SUBSET interval[a,b]``
  ASSUME_TAC THENL
   [UNDISCH_TAC ``c IN interval[a:real,b]`` THEN
    SIMP_TAC std_ss [IN_INTERVAL, SUBSET_INTERVAL, REAL_LE_REFL],
    ALL_TAC] THEN
  SUBGOAL_THEN ``FINITE(p:(real#(real->bool))->bool)`` ASSUME_TAC THENL
   [METIS_TAC[tagged_partial_division_of], ALL_TAC] THEN
  MP_TAC(ASSUME ``(g:real->real->bool) FINE p``) THEN EXPAND_TAC "g" THEN
  ONCE_REWRITE_TAC [METIS [] ``!x.
    (ball (x,
      e / 8 / (abs (f x) + 1) * inf (IMAGE (\m. b - a) (1 .. 1)) /
      content (interval [(a,b)]))) =
    (\x. ball (x,
      e / 8 / (abs (f x) + 1) * inf (IMAGE (\m. b - a) (1 .. 1)) /
      content (interval [(a,b)]))) x``] THEN
  REWRITE_TAC[FINE_INTER] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC ``p:(real#(real->bool))->bool``) THEN
  DISCH_THEN(MP_TAC o SPEC ``h:real->real``) THEN
  KNOW_TAC ``(p :real # (real -> bool) -> bool) tagged_partial_division_of
             interval [((a :real),(b :real))] /\
             (g0 :real -> real -> bool) FINE p /\
             (h :real -> real) IN (fs :(real -> real) -> bool)`` THENL
   [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_OF_SUBSET],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  GEN_REWR_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_HALF] THEN
  MATCH_MP_TAC(REAL_ARITH
   ``x - y <= e / &2 ==> y < e / &2 ==> x < e / 2 + e / 2:real``) THEN
  ASM_SIMP_TAC std_ss [GSYM SUM_SUB] THEN
  SIMP_TAC std_ss [LAMBDA_PROD] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC
   ``sum p (\(x:real,k:real->bool). abs(content k * h x:real))`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC std_ss [FORALL_PROD] THEN
    REWRITE_TAC[REAL_ARITH ``abs y - abs(x - y:real) <= abs x``],
    ALL_TAC] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC
   ``sum p (\(x:real,k).
                   e / &4 * (b - a) / content(interval[a:real,b]) *
                   content(k:real->bool) /
                   (interval_upperbound k - interval_lowerbound k))`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC std_ss [FORALL_PROD] THEN
    MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN DISCH_TAC THEN
    ASM_CASES_TAC ``content(k:real->bool) = &0`` THENL
     [ASM_REWRITE_TAC[real_div, REAL_MUL_LZERO, ABS_0,
                      REAL_MUL_RZERO, REAL_LE_REFL],
      ALL_TAC] THEN
    REWRITE_TAC [real_div] THEN
    ONCE_REWRITE_TAC [REAL_ARITH ``a * b * c * d * content k * f =
                               content k * ((a * b) * (c * d) * f:real)``] THEN
    REWRITE_TAC [GSYM real_div] THEN REWRITE_TAC[ABS_MUL] THEN
    SUBGOAL_THEN ``&0 < content(k:real->bool)`` ASSUME_TAC THENL
     [METIS_TAC[CONTENT_LT_NZ, tagged_partial_division_of], ALL_TAC] THEN
    GEN_REWR_TAC (LAND_CONV o LAND_CONV) [abs] THEN
    ASM_SIMP_TAC std_ss [REAL_LT_IMP_LE, REAL_LE_LMUL] THEN
    MATCH_MP_TAC(REAL_ARITH ``x + &1 <= y ==> x <= y:real``) THEN
    SUBGOAL_THEN ``?u v. k = interval[u:real,v]`` MP_TAC THENL
     [METIS_TAC[tagged_partial_division_of], ALL_TAC] THEN
    DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THEN
    MP_TAC(ISPECL [``u:real``, ``v:real``] CONTENT_POS_LT_EQ) THEN
    ASM_SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_LOWERBOUND, REAL_LT_IMP_LE] THEN
    DISCH_TAC THEN
    W(MP_TAC o PART_MATCH (lhand o rand) REAL_LE_RDIV_EQ o snd) THEN
    ASM_SIMP_TAC std_ss [REAL_SUB_LT] THEN DISCH_THEN SUBST1_TAC THEN
    GEN_REWR_TAC LAND_CONV [REAL_MUL_SYM] THEN
    SIMP_TAC real_ss [GSYM REAL_LE_RDIV_EQ, REAL_ARITH ``&0 < abs(x:real) + &1``] THEN
    UNDISCH_TAC ``(\x. ball (x,
             e / 8 / (abs (f x) + 1) *
             inf (IMAGE (\m. b - a) (1 .. 1)) /
             content (interval [(a,b)]))) FINE p`` THEN
    REWRITE_TAC[FINE] THEN
    DISCH_THEN(MP_TAC o SPECL [``x:real``, ``interval[u:real,v]``]) THEN
    ASM_REWRITE_TAC[SUBSET_DEF] THEN
    DISCH_THEN(fn th => MP_TAC(SPEC ``v:real`` th) THEN
                        MP_TAC(SPEC ``u:real`` th)) THEN
    ASM_SIMP_TAC std_ss [INTERVAL_NE_EMPTY, REAL_LT_IMP_LE, ENDS_IN_INTERVAL] THEN
    REWRITE_TAC[IN_BALL, AND_IMP_INTRO] THEN REWRITE_TAC [dist] THEN
    MATCH_MP_TAC(REAL_ARITH
     ``abs(vi - ui) <= abs(v - u:real) /\ &2 * a <= b
      ==> abs(x - u) < a /\ abs(x - v) < a ==> vi - ui <= b``) THEN
    ASM_SIMP_TAC real_ss [] THEN
    REWRITE_TAC [real_div] THEN ONCE_REWRITE_TAC [REAL_ARITH ``8 = 2 * 4:real``] THEN
    SIMP_TAC real_ss [REAL_INV_MUL] THEN
    ONCE_REWRITE_TAC [REAL_ARITH ``a * (b * (inv a * c) * d * f * g:real) =
                                   b * ((a *inv a) * c) * d * f * g``] THEN
    SIMP_TAC real_ss [REAL_MUL_RINV, REAL_MUL_LID] THEN
    REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
    MATCH_MP_TAC REAL_LE_LMUL_IMP THEN ASM_SIMP_TAC real_ss [REAL_LT_IMP_LE] THEN
    MATCH_MP_TAC REAL_LE_LMUL_IMP THEN KNOW_TAC ``0 <= inv 4:real`` THENL
     [SIMP_TAC real_ss [REAL_INV_1OVER, REAL_LE_RDIV_EQ],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    REWRITE_TAC [REAL_MUL_ASSOC] THEN
    ONCE_REWRITE_TAC [REAL_ARITH ``a * b * c <= e * f * g <=>
                                   (b * a) * c <= (e * g) * f:real``] THEN
    MATCH_MP_TAC REAL_LE_RMUL_IMP THEN
    ASM_SIMP_TAC real_ss [REAL_LE_INV_EQ, REAL_LT_IMP_LE] THEN
    REWRITE_TAC [GSYM real_div] THEN
    MATCH_MP_TAC(REAL_ARITH ``abs x <= e ==> x <= e:real``) THEN
    REWRITE_TAC[real_div, ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN
    REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL
     [MATCH_MP_TAC(REAL_ARITH ``&0 <= x /\ x <= y ==> abs x <= y:real``) THEN
      SIMP_TAC real_ss [NUMSEG_SING, IMAGE_SING, INF_SING, REAL_LE_REFL] THEN
      UNDISCH_TAC ``a < b:real`` THEN REAL_ARITH_TAC,
      KNOW_TAC ``abs ((f:real->real) x) + 1 <> 0:real`` THENL
       [REAL_ARITH_TAC, DISCH_TAC] THEN
      ASM_SIMP_TAC real_ss [ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
      CONJ_TAC THENL [REAL_ARITH_TAC, ALL_TAC] THEN
      MATCH_MP_TAC(REAL_ARITH ``x <= y ==> x + &1 <= abs(y + &1:real)``) THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN
      METIS_TAC[tagged_partial_division_of, SUBSET_DEF]],
    ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP TAGGED_PARTIAL_DIVISION_OF_UNION_SELF) THEN
  DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
    SUM_OVER_TAGGED_DIVISION_LEMMA)) THEN
  ONCE_REWRITE_TAC [METIS []
    ``(\(x,k).
         e / 4 * (b - a) / content (interval [(a,b)]) * content k /
     (interval_upperbound k - interval_lowerbound k)) =
      (\(x,k).
    (\k. e / 4 * (b - a) / content (interval [(a,b)]) * content k /
     (interval_upperbound k - interval_lowerbound k)) k)``] THEN
  DISCH_THEN(fn th =>
    W(MP_TAC o PART_MATCH (lhs o rand) th o lhand o snd)) THEN
  SIMP_TAC std_ss [] THEN
  KNOW_TAC ``(!(u :real) (v :real).
    interval [(u,v)] <> ({} :real -> bool) ==>
    (content (interval [(u,v)]) = (0 :real)) ==>
    ((e :real) / (4 :real) * ((b :real) - (a :real)) /
     content (interval [(a,b)]) * (0 :real) /
     (interval_upperbound (interval [(u,v)]) -
      interval_lowerbound (interval [(u,v)])) =
     (0 : real)))`` THENL
   [SIMP_TAC std_ss [real_div, REAL_MUL_LZERO, REAL_MUL_RZERO],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    DISCH_THEN SUBST1_TAC] THEN
  REWRITE_TAC [real_div] THEN
  KNOW_TAC ``sum
  (IMAGE (SND :real # (real -> bool) -> real -> bool)
     (p :real # (real -> bool) -> bool))
  (\(k :real -> bool).
     ((e :real) * inv (4 :real) * ((b :real) - (a :real)) *
     inv (content (interval [(a,b)]))) * (\k. content k *
     inv (interval_upperbound k - interval_lowerbound k)) k) <=
    e * inv (2 :real)`` THENL
  [ALL_TAC, SIMP_TAC std_ss [] THEN REWRITE_TAC [REAL_MUL_ASSOC]] THEN
  REWRITE_TAC [SUM_LMUL] THEN
  ONCE_REWRITE_TAC [REAL_ARITH ``a * b * c * d * e = (a * c * d * e) * b:real``] THEN
  REWRITE_TAC [GSYM real_div] THEN SIMP_TAC real_ss [REAL_LE_LDIV_EQ] THEN
  REWRITE_TAC [REAL_ARITH ``4 = 2 * 2:real``, real_div, REAL_MUL_ASSOC] THEN
  ONCE_REWRITE_TAC [REAL_ARITH ``a * b * c * d = a * (b * c) * d:real``] THEN
  SIMP_TAC real_ss [REAL_MUL_LINV] THEN SIMP_TAC real_ss [REAL_MUL_ASSOC] THEN
  ASM_SIMP_TAC real_ss [GSYM REAL_MUL_ASSOC, REAL_LE_LMUL] THEN
  ONCE_REWRITE_TAC [REAL_ARITH ``a * (b * c) = (a * c) * b:real``] THEN
  REWRITE_TAC [GSYM real_div] THEN ASM_SIMP_TAC std_ss [REAL_LE_LDIV_EQ] THEN
  MATCH_MP_TAC SUM_CONTENT_AREA_OVER_THIN_DIVISION THEN
  EXISTS_TAC ``BIGUNION (IMAGE SND (p:(real#(real->bool))->bool))`` THEN
  EXISTS_TAC ``(c:real)`` THEN
  RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_SIMP_TAC std_ss [] THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC DIVISION_OF_TAGGED_DIVISION THEN
    ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_OF_UNION_SELF],
    SIMP_TAC std_ss [BIGUNION_SUBSET, FORALL_IN_IMAGE, FORALL_PROD] THEN
    METIS_TAC[tagged_partial_division_of],
    ASM_SIMP_TAC std_ss [FORALL_IN_IMAGE, FORALL_PROD] THEN
    METIS_TAC []]
QED

val lemma = prove (
   ``(!x k. (x,k) IN IMAGE (\(x,k). f x k,g x k) s ==> Q x k) <=>
     (!x k. (x,k) IN s ==> Q (f x k) (g x k))``,
    SIMP_TAC std_ss [IN_IMAGE, PAIR_EQ, EXISTS_PROD] THEN SET_TAC[]);

Theorem EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE :
    !fs f:real->real a b.
        fs equiintegrable_on interval[a,b] /\ f IN fs /\
        (!h x. h IN fs /\ x IN interval[a,b] ==> abs(h x) <= abs(f x))
        ==> { (\x. if x <= c then h x else 0) | c IN univ(:real) /\ h IN fs }
            equiintegrable_on interval[a,b]
Proof
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC ``content(interval[a:real,b]) = &0`` THEN
  ASM_SIMP_TAC std_ss [EQUIINTEGRABLE_ON_NULL] THEN
  FIRST_ASSUM(MP_TAC o REWRITE_RULE [GSYM CONTENT_LT_NZ]) THEN
  DISCH_THEN(fn th => ASSUME_TAC th THEN MP_TAC th) THEN
  REWRITE_TAC[CONTENT_POS_LT_EQ] THEN STRIP_TAC THEN
  REWRITE_TAC[equiintegrable_on] THEN
  SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM, FORALL_IN_GSPEC] THEN
  SIMP_TAC std_ss [IN_UNIV, AND_IMP_INTRO, GSYM CONJ_ASSOC, RIGHT_IMP_FORALL_THM,
              IN_NUMSEG] THEN
  UNDISCH_TAC ``fs equiintegrable_on interval [(a,b)]`` THEN DISCH_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o REWRITE_RULE[equiintegrable_on]) THEN
  MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
  [ (* goal 1 (of 2) *)
    REPEAT GEN_TAC THEN
    ONCE_REWRITE_TAC[SET_RULE ``x <= c <=> x IN {x:real | x <= c}``] THEN
    REWRITE_TAC[INTEGRABLE_RESTRICT_INTER] THEN
    ONCE_REWRITE_TAC[INTER_COMM] THEN SIMP_TAC std_ss [INTERVAL_SPLIT] THEN
    REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN
    EXISTS_TAC ``interval[a:real,b]`` THEN ASM_SIMP_TAC std_ss [] THEN
    SIMP_TAC std_ss [SUBSET_INTERVAL, REAL_LE_REFL] THEN
    rw [REAL_LE_MIN, REAL_MIN_LE, REAL_LE_REFL],
    (* goal 2 (of 2) *)
    DISCH_TAC ] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  MP_TAC(ISPECL [``fs:(real->real)->bool``, ``f:real->real``,
                 ``a:real``, ``b:real``, ``e / &12:real``]
        BOUNDED_EQUIINTEGRAL_OVER_THIN_TAGGED_PARTIAL_DIVISION) THEN
  ASM_SIMP_TAC real_ss [REAL_LT_DIV, REAL_ARITH ``&0 < &12:real``] THEN
  DISCH_THEN(X_CHOOSE_THEN ``g0:real->real->bool`` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   ``?d. gauge d /\
        !p h. p tagged_partial_division_of interval [a,b] /\
              d FINE p /\ (h:real->real) IN fs
              ==> sum p (\(x,k). abs(content k * h x - integral k h)) <
                  e / &3``
   (X_CHOOSE_THEN ``g1:real->real->bool`` STRIP_ASSUME_TAC)
  THENL
   [UNDISCH_TAC ``fs equiintegrable_on interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o CONJUNCT2 o REWRITE_RULE[equiintegrable_on]) THEN
    DISCH_THEN(MP_TAC o SPEC ``e / &7 / ((&1:real) + &1)``) THEN
    ASM_SIMP_TAC real_ss [REAL_LT_DIV, REAL_ARITH ``&0 < &7:real``,
     METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0] ``&0 < &n + &1:real``] THEN
    DISCH_THEN (X_CHOOSE_TAC ``d:real->real->bool``) THEN
    EXISTS_TAC ``d:real->real->bool`` THEN POP_ASSUM MP_TAC THEN
    STRIP_TAC THEN ASM_SIMP_TAC std_ss [] THEN
    MAP_EVERY X_GEN_TAC
     [``p:(real#(real->bool))->bool``, ``h:real->real``] THEN
    STRIP_TAC THEN
    MP_TAC(ISPECL [``h:real->real``, ``a:real``, ``b:real``,
           ``d:real->real->bool``, ``e / &7 / ((&1:real) + &1)``]
        HENSTOCK_LEMMA_PART2) THEN
    ASM_SIMP_TAC real_ss [REAL_LT_DIV, REAL_ARITH ``&0 < &7:real``,
      METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0] ``&0 < &n + &1:real``] THEN
    DISCH_THEN(MP_TAC o SPEC ``p:(real#(real->bool))->bool``) THEN
    ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC(REAL_ARITH
     ``a < b ==> x <= a ==> x < b:real``) THEN
    REWRITE_TAC [real_div, REAL_MUL_ASSOC] THEN
    ONCE_REWRITE_TAC [REAL_ARITH ``a * b * c * inv a = (a * inv a) * b * c:real``] THEN
    SIMP_TAC real_ss [REAL_MUL_RINV] THEN REWRITE_TAC [GSYM real_div] THEN
    SIMP_TAC real_ss [REAL_LT_RDIV_EQ] THEN ONCE_REWRITE_TAC [REAL_MUL_SYM] THEN
    REWRITE_TAC [real_div, REAL_MUL_ASSOC] THEN REWRITE_TAC [GSYM real_div] THEN
    SIMP_TAC real_ss [REAL_LT_LDIV_EQ] THEN UNDISCH_TAC ``0 < e:real`` THEN
    REAL_ARITH_TAC,
    ALL_TAC] THEN
  EXISTS_TAC ``\x. (g0:real->real->bool) x INTER g1 x`` THEN
  ASM_SIMP_TAC std_ss [GAUGE_INTER, FINE_INTER] THEN
  KNOW_TAC ``!(c :real). (\c. !(h :real -> real) (p :real # (real -> bool) -> bool).
  h IN (fs :(real -> real) -> bool) /\
  p tagged_division_of interval [((a :real),(b :real))] /\
  (g0 :real -> real -> bool) FINE p /\
  (g1 :real -> real -> bool) FINE p ==>
  abs
    (sum p
       (\((x :real),(k :real -> bool)).
          content k * if x <= c then h x else (0 :real)) -
     integral (interval [(a,b)])
       (\(x :real). if x <= c then h x else (0 :real))) < (e :real)) c`` THENL
  [ALL_TAC, METIS_TAC []] THEN
  MP_TAC(MESON[]
   ``!P. ((!c. (a:real) <= c /\ c <= (b:real) ==> P c) ==> (!c. P c)) /\
        (!c. (a:real) <= c /\ c <= (b:real) ==> P c)
        ==> !c. P c``) THEN
  DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THEN SIMP_TAC std_ss [] THENL
  [ (* goal 1 (of 2) *)
    DISCH_THEN(ASSUME_TAC) THEN
    X_GEN_TAC ``c:real`` THEN
    ASM_CASES_TAC ``(a:real) <= c /\ c <= (b:real)`` THENL
    [ UNDISCH_TAC ``!c.
         a <= c /\ c <= b ==>
         !h p. h IN fs /\ p tagged_division_of interval [(a,b)] /\
           g0 FINE p /\ g1 FINE p ==>
           abs (sum p (\(x,k). content k * if x <= c then h x else 0) -
              integral (interval [(a,b)])
                (\x. if x <= c then h x else 0)) < e`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[], ALL_TAC ] THEN
    UNDISCH_TAC ``!c.
         a <= c /\ c <= b ==>
         !h p. h IN fs /\ p tagged_division_of interval [(a,b)] /\
           g0 FINE p /\ g1 FINE p ==>
           abs (sum p (\(x,k). content k * if x <= c then h x else 0) -
              integral (interval [(a,b)])
                (\x. if x <= c then h x else 0)) < e`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM (MP_TAC o SPEC ``(b:real)``) THEN
    ASM_SIMP_TAC std_ss [REAL_LT_IMP_LE, REAL_LE_REFL] THEN
    DISCH_TAC THEN X_GEN_TAC ``h:real->real`` THEN
    X_GEN_TAC ``p:real#(real->bool)->bool`` THEN
    POP_ASSUM (MP_TAC o SPECL [``h:real->real``,``p:real#(real->bool)->bool``]) THEN
    DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
    UNDISCH_TAC ``~(a <= c /\ c <= b:real)`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [DE_MORGAN_THM]) THEN
    REWRITE_TAC[REAL_NOT_LE] THEN STRIP_TAC THENL
    [ (* goal 1.1 (of 2) *)
      DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH
       ``(x:real = 0) /\ (y = 0) /\ &0 < e ==> abs(x - y) < e:real``) THEN
      ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
      [ MATCH_MP_TAC SUM_EQ_0 THEN SIMP_TAC std_ss [FORALL_PROD] THEN
        MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN DISCH_TAC THEN
        COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [REAL_MUL_RZERO] THEN
        SUBGOAL_THEN ``(x:real) IN interval[a,b]`` MP_TAC THENL
         [ASM_MESON_TAC[TAGGED_DIVISION_OF, SUBSET_DEF], ALL_TAC] THEN
        REWRITE_TAC[IN_INTERVAL] THEN
        UNDISCH_TAC ``c < a:real`` THEN POP_ASSUM MP_TAC THEN
        REAL_ARITH_TAC,
        MATCH_MP_TAC EQ_TRANS THEN
        EXISTS_TAC ``integral(interval[a,b]) ((\x. 0):real->real)`` THEN
        CONJ_TAC THENL [ALL_TAC, SIMP_TAC std_ss [INTEGRAL_0]] THEN
        MATCH_MP_TAC INTEGRAL_EQ THEN SIMP_TAC std_ss [] THEN GEN_TAC THEN
        COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL] THEN
        UNDISCH_TAC ``c < a:real`` THEN POP_ASSUM MP_TAC THEN
        REAL_ARITH_TAC],
      (* goal 1.2 (of 2) *)
      MATCH_MP_TAC(REAL_ARITH
       ``(x:real = y) /\ (w = z) ==> abs(x - w) < e ==> abs(y - z) < e``) THEN
      CONJ_TAC THENL
      [ (* goal 1.2.1 (of 2) *)
        MATCH_MP_TAC SUM_EQ THEN SIMP_TAC std_ss [FORALL_PROD] THEN
        MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN DISCH_TAC THEN
        SUBGOAL_THEN ``(x:real) IN interval[a,b]`` MP_TAC THENL
         [ASM_MESON_TAC[TAGGED_DIVISION_OF, SUBSET_DEF], ALL_TAC] THEN
        REWRITE_TAC[IN_INTERVAL] THEN
        STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
        COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN
        UNDISCH_TAC ``b < c:real`` THEN POP_ASSUM MP_TAC THEN
        POP_ASSUM MP_TAC THEN REAL_ARITH_TAC,
        (* goal 1.2.2 (of 2) *)
        MATCH_MP_TAC INTEGRAL_EQ THEN SIMP_TAC std_ss [] THEN GEN_TAC THEN
        rpt COND_CASES_TAC THEN ASM_SIMP_TAC real_ss [IN_INTERVAL] THEN
        NTAC 3 (POP_ASSUM MP_TAC) >> REAL_ARITH_TAC ] ],
    (* goal 2 (of 2) *)
    ALL_TAC ] THEN
  X_GEN_TAC ``c:real`` THEN DISCH_TAC THEN
  MAP_EVERY X_GEN_TAC [``h:real->real``,
                  ``p:(real#(real->bool))->bool``] THEN STRIP_TAC THEN
  ABBREV_TAC
   ``q:(real#(real->bool))->bool =
        {(x,k) | (x,k) IN p /\ ~(k INTER {x | x <= c} = {})}`` THEN
  MP_TAC(ISPECL
   [``\x. if x <= c then (h:real->real) x else 0``,
    ``a:real``, ``b:real``, ``p:(real#(real->bool))->bool``]
        INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN) THEN
  ASM_SIMP_TAC std_ss [] THEN DISCH_THEN SUBST1_TAC THEN
  SUBGOAL_THEN ``FINITE(p:(real#(real->bool))->bool)`` ASSUME_TAC THENL
   [ASM_MESON_TAC[TAGGED_DIVISION_OF], ALL_TAC] THEN
  SUBGOAL_THEN ``q SUBSET (p:(real#(real->bool))->bool)`` ASSUME_TAC THENL
   [EXPAND_TAC "q" THEN SIMP_TAC std_ss [SUBSET_DEF, FORALL_PROD, IN_ELIM_PAIR_THM],
    ALL_TAC] THEN
  SUBGOAL_THEN ``FINITE(q:(real#(real->bool))->bool)`` ASSUME_TAC THENL
   [ASM_MESON_TAC[FINITE_SUBSET], ALL_TAC] THEN
  ASM_SIMP_TAC std_ss [GSYM SUM_SUB] THEN SIMP_TAC std_ss [LAMBDA_PROD] THEN
  SUBGOAL_THEN ``q tagged_partial_division_of interval[a:real,b] /\
                g0 FINE q /\ g1 FINE q``
  STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_SUBSET, tagged_division_of,
                  FINE_SUBSET],
    ALL_TAC] THEN
  MATCH_MP_TAC(MESON[] ``!q. (sum p s = sum q s) /\ abs(sum q s) < e
                            ==> abs(sum p s:real) < e``) THEN
  EXISTS_TAC ``q:(real#(real->bool))->bool`` THEN CONJ_TAC THENL
  [ (* goal 1 (of 2) *)
    MATCH_MP_TAC SUM_SUPERSET THEN ASM_SIMP_TAC std_ss [FORALL_PROD] THEN
    EXPAND_TAC "q" THEN SIMP_TAC std_ss [IN_ELIM_PAIR_THM] THEN
    MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN
    SUBGOAL_THEN ``(x:real) IN k`` ASSUME_TAC THENL
     [ASM_MESON_TAC[TAGGED_DIVISION_OF], ALL_TAC] THEN
    DISCH_THEN(fn th => ASSUME_TAC th THEN MP_TAC th) THEN
    REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN
    REWRITE_TAC[IN_INTER, NOT_IN_EMPTY] THEN ASM_SIMP_TAC std_ss [] THEN
    SIMP_TAC std_ss [GSPECIFICATION] THEN DISCH_TAC THEN
    ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN
    REWRITE_TAC[REAL_NEG_EQ0, REAL_SUB_LZERO] THEN
    MATCH_MP_TAC EQ_TRANS THEN
    EXISTS_TAC ``integral k ((\x. 0):real->real)`` THEN
    CONJ_TAC THENL [ALL_TAC, REWRITE_TAC[INTEGRAL_0]] THEN
    MATCH_MP_TAC INTEGRAL_EQ THEN ASM_SET_TAC[],
    (* goal 2 (of 2) *)
    ALL_TAC ] THEN
  SUBGOAL_THEN
   ``abs(sum q (\(x,k). content k * h x - integral k (h:real->real)))
        < e / &3``
  MP_TAC THENL
   [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ``sum q
      (\(x,k). abs(content k * h x - integral k (h:real->real)))`` THEN
    ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC SUM_ABS_LE THEN
    ASM_SIMP_TAC std_ss [FORALL_PROD, REAL_LE_REFL],
    ALL_TAC] THEN
  SIMP_TAC real_ss [REAL_LT_RDIV_EQ] THEN
  MATCH_MP_TAC(REAL_ARITH
   ``abs(x - y:real) * 3 <= &2 * e
    ==> abs(x) * 3 < e ==> abs(y) < e``) THEN
  SIMP_TAC real_ss [GSYM REAL_LE_RDIV_EQ] THEN
  ASM_SIMP_TAC std_ss [GSYM SUM_SUB] THEN SIMP_TAC std_ss [LAMBDA_PROD] THEN
  ABBREV_TAC
   ``r:(real#(real->bool))->bool =
        {(x,k) | (x,k) IN q /\ ~(k SUBSET {x | x <= c})}`` THEN
  SUBGOAL_THEN ``r SUBSET (q:(real#(real->bool))->bool)`` ASSUME_TAC THENL
   [EXPAND_TAC "r" THEN SIMP_TAC std_ss [SUBSET_DEF, FORALL_PROD, IN_ELIM_PAIR_THM],
    ALL_TAC] THEN
  SUBGOAL_THEN ``FINITE(r:(real#(real->bool))->bool)`` ASSUME_TAC THENL
   [ASM_MESON_TAC[FINITE_SUBSET], ALL_TAC] THEN
  SUBGOAL_THEN ``r tagged_partial_division_of interval[a:real,b] /\
                g0 FINE r /\ g1 FINE r``
  STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_SUBSET, FINE_SUBSET],
    ALL_TAC] THEN
  MATCH_MP_TAC(MESON[] ``!r. (sum q s = sum r s) /\ abs(sum r s) <= e
                            ==> abs(sum q s:real) <= e``) THEN
  EXISTS_TAC ``r:(real#(real->bool))->bool`` THEN CONJ_TAC THENL
  [ (* goal 1 (of 2) *)
    MATCH_MP_TAC SUM_SUPERSET THEN ASM_SIMP_TAC std_ss [FORALL_PROD] THEN
    EXPAND_TAC "r" THEN SIMP_TAC std_ss [IN_ELIM_PAIR_THM] THEN
    MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_SIMP_TAC std_ss [] THEN
    SUBGOAL_THEN ``(x:real) IN k`` ASSUME_TAC THENL
     [ASM_MESON_TAC[tagged_partial_division_of], ALL_TAC] THEN
    DISCH_THEN(fn th => ASSUME_TAC th THEN MP_TAC th) THEN
    REWRITE_TAC[SUBSET_DEF] THEN DISCH_THEN(MP_TAC o SPEC ``x:real``) THEN
    ASM_SIMP_TAC std_ss [GSPECIFICATION] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[REAL_ARITH ``c - i - (c - j):real = j - i``] THEN
    REWRITE_TAC[REAL_SUB_0] THEN MATCH_MP_TAC INTEGRAL_EQ THEN
    ASM_SET_TAC[],
    (* goal 2 (of 2) *)
    ALL_TAC ] THEN
  W(MP_TAC o PART_MATCH (lhand o rand) SUM_ABS o lhand o snd) THEN
  ASM_SIMP_TAC std_ss [] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
  ONCE_REWRITE_TAC[LAMBDA_PROD] THEN REWRITE_TAC[] THEN
  MAP_EVERY ABBREV_TAC
   [``s:(real#(real->bool))->bool =
        {(x,k) | (x,k) IN r /\ x IN {x | x <= c}}``,
    ``t:(real#(real->bool))->bool =
        {(x,k) | (x,k) IN r /\ ~(x IN {x | x <= c})}``] THEN
  SUBGOAL_THEN
   ``(s:(real#(real->bool))->bool) SUBSET r /\
     (t:(real#(real->bool))->bool) SUBSET r``
  STRIP_ASSUME_TAC THENL
   [MAP_EVERY EXPAND_TAC ["s", "t"] THEN
    SIMP_TAC std_ss [SUBSET_DEF, FORALL_PROD, IN_ELIM_PAIR_THM],
    ALL_TAC] THEN
  SUBGOAL_THEN
   ``FINITE(s:(real#(real->bool))->bool) /\
     FINITE(t:(real#(real->bool))->bool)``
  STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET], ALL_TAC] THEN
  SUBGOAL_THEN ``DISJOINT (s:(real#(real->bool))->bool) t`` ASSUME_TAC THENL
   [MAP_EVERY EXPAND_TAC ["s", "t"] THEN
    SIMP_TAC std_ss [EXTENSION, DISJOINT_DEF, IN_INTER, FORALL_PROD,
                IN_ELIM_PAIR_THM] THEN SET_TAC[],
    ALL_TAC] THEN
  SUBGOAL_THEN ``r:(real#(real->bool))->bool = s UNION t`` SUBST1_TAC THENL
   [MAP_EVERY EXPAND_TAC ["s", "t"] THEN
    SIMP_TAC std_ss [EXTENSION, IN_UNION, FORALL_PROD, IN_ELIM_PAIR_THM] THEN
    SET_TAC[],
    ALL_TAC] THEN
  ASM_SIMP_TAC std_ss [SUM_UNION] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
   ``sum s (\(x:real,k). abs
          (integral k (h:real->real) -
           integral k (\x. if x <= c then h x else 0))) +
    sum t (\(x:real,k). abs
          ((content k * (h:real->real) x - integral k h) +
           integral k (\x. if x <= c then h x else 0)))`` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC REAL_EQ_IMP_LE THEN BINOP_TAC THEN
    MATCH_MP_TAC SUM_EQ THEN SIMP_TAC std_ss [FORALL_PROD] THEN
    MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN
    MAP_EVERY EXPAND_TAC ["s", "t"] THEN
    SIMP_TAC std_ss [IN_ELIM_PAIR_THM] THEN SIMP_TAC std_ss [GSPECIFICATION] THEN
    STRIP_TAC THEN ASM_SIMP_TAC std_ss [] THENL
     [MATCH_MP_TAC(REAL_ARITH ``(a:real = -b) ==> (abs a = abs b)``) THEN
      REAL_ARITH_TAC,
      AP_TERM_TAC THEN REAL_ARITH_TAC],
    ALL_TAC] THEN
  SUBGOAL_THEN ``s tagged_partial_division_of interval[a:real,b] /\
                t tagged_partial_division_of interval[a:real,b] /\
                g0 FINE s /\ g1 FINE s /\ g0 FINE t /\ g1 FINE t``
  STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_SUBSET, FINE_SUBSET],
    ALL_TAC] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
   ``(sum s (\(x:real,k). abs(integral k (h:real->real))) +
     sum (IMAGE (\(x,k). (x,k INTER {x | x <= c})) s)
         (\(x:real,k). abs(integral k (h:real->real)))) +
    (sum t (\(x:real,k). abs(content k * h x - integral k h)) +
     sum t (\(x:real,k). abs(integral k (h:real->real))) +
     sum (IMAGE (\(x,k). (x,k INTER {x | x >= c})) t)
         (\(x:real,k). abs(integral k (h:real->real))))`` THEN
  CONJ_TAC THENL
  [ (* goal 1 (of 2) *)
    MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL
    [ (* goal 1.1 (of 2) *)
      W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_NONZERO o
        rand o rand o snd) THEN
      KNOW_TAC ``FINITE (s :real # (real -> bool) -> bool) /\
      (!(x :real # (real -> bool)) (y :real # (real -> bool)).
        x IN s /\ y IN s /\ x <> y /\
      ((\((x :real),(k :real -> bool)). (x,k INTER {x | x <= (c :real)}))
       x = (\((x :real),(k :real -> bool)). (x,k INTER {x | x <= c})) y) ==>
      ((\((x :real),(k :real -> bool)).
        abs (integral k (h :real -> real)))
       ((\((x :real),(k :real -> bool)). (x,k INTER {x | x <= c})) x) =
      (0 : real)))`` THENL
      [ (* goal 1.1.1 (of 2) *)
        ASM_SIMP_TAC std_ss [FORALL_PROD] THEN
        MAP_EVERY X_GEN_TAC
         [``x:real``, ``k:real->bool``, ``l:real->bool``] THEN
        ASM_SIMP_TAC std_ss [PAIR_EQ] THEN
        REPEAT STRIP_TAC THEN MP_TAC(ISPECL
         [``s:real#(real->bool)->bool``,
          ``BIGUNION(IMAGE SND (s:real#(real->bool)->bool))``,
          ``x:real``, ``k:real->bool``,
          ``x:real``, ``l:real->bool``, ``c:real``]
         TAGGED_DIVISION_SPLIT_LEFT_INJ) THEN
        ASM_SIMP_TAC std_ss [] THEN
        KNOW_TAC ``s tagged_division_of BIGUNION (IMAGE SND s)`` THENL
         [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_OF_UNION_SELF],
          DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
        REWRITE_TAC[ABS_ZERO] THEN
        SUBGOAL_THEN ``?u v:real. l = interval[u,v]``
         (REPEAT_TCL CHOOSE_THEN SUBST1_TAC)
        THENL [ASM_MESON_TAC[tagged_partial_division_of], ALL_TAC] THEN
        ASM_SIMP_TAC std_ss [INTERVAL_SPLIT, INTEGRAL_NULL],
        (* goal 1.1.2 (of 2) *)
        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
        DISCH_THEN SUBST1_TAC THEN
        ASM_SIMP_TAC std_ss [GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN
        ASM_SIMP_TAC std_ss [o_THM, FORALL_PROD] THEN
        GEN_REWR_TAC (QUANT_CONV o QUANT_CONV o RAND_CONV o LAND_CONV o
                      ONCE_DEPTH_CONV) [SET_RULE
         ``x <= c <=> x IN {x:real | x <= c}``] THEN
        SIMP_TAC std_ss [INTEGRAL_RESTRICT_INTER] THEN
        SIMP_TAC std_ss [GSPECIFICATION, INTER_COMM] THEN
        REWRITE_TAC[REAL_ARITH ``abs(a - b:real) <= abs a + abs b``] ],
      (* goal 1.2 (of 2) *)
      MP_TAC (ISPECL [``(\((x :real),(k :real -> bool)). abs (integral k h))``,
       ``(\((x :real),(k :real -> bool)). (x,k INTER {x | x >= c}))``,
       ``(t :real # (real -> bool) -> bool)``] SUM_IMAGE_NONZERO) THEN
      KNOW_TAC ``FINITE (t :real # (real -> bool) -> bool) /\
       (!(x :real # (real -> bool)) (y :real # (real -> bool)).
         x IN t /\ y IN t /\ x <> y /\
       ((\((x :real),(k :real -> bool)). (x,k INTER {x | x >= (c :real)}))
       x = (\((x :real),(k :real -> bool)). (x,k INTER {x | x >= c})) y) ==>
       ((\((x :real),(k :real -> bool)).
        abs (integral k (h :real -> real)))
       ((\((x :real),(k :real -> bool)). (x,k INTER {x | x >= c})) x) =
       (0 : real)))`` THENL
      [ (* goal 1.2.1 (of 2) *)
        ASM_SIMP_TAC std_ss [FORALL_PROD, PAIR_EQ] THEN
        MAP_EVERY X_GEN_TAC
         [``x:real``, ``k:real->bool``, ``l:real->bool``] THEN
        ASM_SIMP_TAC std_ss [PAIR_EQ] THEN
        REPEAT STRIP_TAC THEN MP_TAC(ISPECL
         [``t:real#(real->bool)->bool``,
          ``BIGUNION(IMAGE SND (t:real#(real->bool)->bool))``,
          ``x:real``, ``k:real->bool``,
          ``x:real``, ``l:real->bool``, ``c:real``]
         TAGGED_DIVISION_SPLIT_RIGHT_INJ) THEN
        ASM_SIMP_TAC std_ss [] THEN
        KNOW_TAC ``t tagged_division_of BIGUNION (IMAGE SND t)`` THENL
         [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_OF_UNION_SELF],
          DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
        REWRITE_TAC[ABS_ZERO] THEN
        SUBGOAL_THEN ``?u v:real. l = interval[u,v]``
         (REPEAT_TCL CHOOSE_THEN SUBST1_TAC)
        THENL [ASM_MESON_TAC[tagged_partial_division_of], ALL_TAC] THEN
        ASM_SIMP_TAC std_ss [INTERVAL_SPLIT, INTEGRAL_NULL],
        (* goal 1.2.2 (of 2) *)
        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
        DISCH_THEN SUBST1_TAC THEN
        ASM_SIMP_TAC std_ss [GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN
        ASM_SIMP_TAC std_ss [o_THM, FORALL_PROD] THEN
        MAP_EVERY X_GEN_TAC [``x:real``, ``k:real->bool``] THEN DISCH_TAC THEN
        MATCH_MP_TAC(REAL_ARITH
         ``(i = i1 + i2)
          ==> abs(c + i1:real) <= abs(c) + abs(i) + abs(i2)``) THEN
        ONCE_REWRITE_TAC[SET_RULE
         ``x <= c <=> x IN {x:real | x <= c}``] THEN
        SIMP_TAC std_ss [INTEGRAL_RESTRICT_INTER] THEN
        ONCE_REWRITE_TAC[SET_RULE
        ``{x | x <= c:real} INTER s = s INTER {x | x <= c}``] THEN
        SUBGOAL_THEN ``?u v:real. k = interval[u,v]``
         (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC)
        THENL [ASM_MESON_TAC[tagged_partial_division_of], ALL_TAC] THEN
        ASM_SIMP_TAC std_ss [INTERVAL_SPLIT] THEN
        MATCH_MP_TAC (SIMP_RULE std_ss [] INTEGRAL_SPLIT) THEN
        ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN
        EXISTS_TAC ``interval[a:real,b]`` THEN
        ASM_SIMP_TAC std_ss [] THEN
        ASM_MESON_TAC[tagged_partial_division_of] ] ],
    (* goal 2 (of 2) *)
    ALL_TAC] THEN
  SUBGOAL_THEN
   ``!x:real k. (x,k) IN r ==> ~(k INTER {x:real | x = c} = {})``
  ASSUME_TAC THENL
   [REPEAT GEN_TAC THEN MAP_EVERY EXPAND_TAC ["r", "q"] THEN
    SIMP_TAC std_ss [IN_ELIM_PAIR_THM] THEN
    SIMP_TAC std_ss [GSYM CONJ_ASSOC, SUBSET_DEF, EXTENSION, NOT_FORALL_THM] THEN
    KNOW_TAC ``(x,k) IN (p :real # (real -> bool) -> bool) /\
               (?x. x IN k /\ x <= c) /\ (?x. x IN k /\ ~(x <= c))
           ==> (?x. x IN k /\ (x = c))`` THENL
    [ALL_TAC,
     SIMP_TAC std_ss [GSPECIFICATION, NOT_IN_EMPTY, IN_INTER, NOT_IMP]] THEN
    DISCH_TAC THEN MATCH_MP_TAC CONNECTED_IVT_COMPONENT THEN
    SIMP_TAC std_ss [RIGHT_EXISTS_AND_THM] THEN
    CONJ_TAC THENL [ALL_TAC, ASM_MESON_TAC[REAL_LE_TOTAL]] THEN
    SUBGOAL_THEN ``?u v:real. k = interval[u,v]``
     (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC)
    THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF], ALL_TAC] THEN
    MATCH_MP_TAC CONVEX_CONNECTED THEN REWRITE_TAC[CONVEX_INTERVAL],
    ALL_TAC] THEN
  SIMP_TAC real_ss [REAL_LE_RDIV_EQ] THEN
  (* stage work *)
  MATCH_MP_TAC(REAL_ARITH
   ``x * 6 <= e /\ y * 2 <= e ==> (x + y) * 3 <= &2 * e:real``) THEN
  CONJ_TAC THENL
  [ (* goal 1 (of 2) *)
    MATCH_MP_TAC(REAL_ARITH
     ``x * 12 < e /\ y * 12 < e ==> (x + y) * 6 <= e:real``) THEN
    CONJ_TAC THEN SIMP_TAC real_ss [GSYM REAL_LT_RDIV_EQ] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    EXISTS_TAC ``c:real`` THEN
    ASM_SIMP_TAC std_ss [IN_INTERVAL] THENL
    [ EXPAND_TAC "s" THEN SIMP_TAC std_ss [IN_ELIM_PAIR_THM] THEN
      ASM_MESON_TAC[],
      REPEAT CONJ_TAC THENL
      [ UNDISCH_TAC ``s tagged_partial_division_of interval[a:real,b]``,
        UNDISCH_TAC ``(g0:real->real->bool) FINE s`` THEN
        SIMP_TAC std_ss [FINE, FORALL_IN_IMAGE, lemma] THEN SET_TAC[],
        SIMP_TAC std_ss [lemma] THEN
        REPEAT GEN_TAC THEN EXPAND_TAC "s" THEN
        SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN
        DISCH_TAC THEN MATCH_MP_TAC(SET_RULE
        ``~(k INTER t = {}) /\ t SUBSET s ==> ~((k INTER s) INTER t = {})``) THEN
        SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION, REAL_LE_REFL, EXISTS_PROD] THEN
        FIRST_X_ASSUM MATCH_MP_TAC THEN METIS_TAC[] ] ],
    (* goal 2 (of 2) *)
    MATCH_MP_TAC(REAL_ARITH
     ``x * 3 < e /\ y * 12 < e /\ z * 12 < e ==> (x + y + z) * 2 <= e:real``) THEN
    REPEAT CONJ_TAC THEN SIMP_TAC real_ss [GSYM REAL_LT_RDIV_EQ] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC std_ss [] THEN
    EXISTS_TAC ``c:real`` THEN
    ASM_SIMP_TAC std_ss [IN_INTERVAL] THENL
    [ EXPAND_TAC "t" THEN SIMP_TAC std_ss [IN_ELIM_PAIR_THM] THEN
      ASM_MESON_TAC[],
      REPEAT CONJ_TAC THENL
      [ UNDISCH_TAC ``t tagged_partial_division_of interval[a:real,b]``,
        UNDISCH_TAC ``(g0:real->real->bool) FINE t`` THEN
        SIMP_TAC std_ss [FINE, FORALL_IN_IMAGE, lemma] THEN SET_TAC[],
        SIMP_TAC std_ss [lemma] THEN
        REPEAT GEN_TAC THEN EXPAND_TAC "t" THEN
        SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN
        DISCH_TAC THEN MATCH_MP_TAC(SET_RULE
        ``~(k INTER t = {}) /\ t SUBSET s ==> ~((k INTER s) INTER t = {})``) THEN
        SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION, REAL_LE_REFL,
                         real_ge, EXISTS_PROD] THEN
        FIRST_X_ASSUM MATCH_MP_TAC THEN METIS_TAC[] ] ] ] THEN
  (* A shared tactic *)
  SIMP_TAC std_ss [tagged_partial_division_of] THENL
  [(* goal 1 (of 2) *)
   MATCH_MP_TAC MONO_AND THEN SIMP_TAC std_ss [IMAGE_FINITE] THEN
   MATCH_MP_TAC MONO_AND THEN
   SIMP_TAC std_ss [RIGHT_FORALL_IMP_THM, IMP_CONJ, FORALL_IN_GSPEC] THEN
   SIMP_TAC std_ss [lemma] THEN CONJ_TAC THEN
   DISCH_TAC THEN X_GEN_TAC ``x:real`` THEN X_GEN_TAC ``k:real->bool`` THEN
   POP_ASSUM (MP_TAC o SPECL [``x:real``,``k:real->bool``]) THEN
   DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC std_ss [] THENL
   [ MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
     [ SIMP_TAC std_ss [real_ge, IN_INTER, GSPECIFICATION] THEN
       ASM_SET_TAC[REAL_LE_TOTAL],
       MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
       [ SET_TAC[],
         STRIP_TAC THEN ASM_SIMP_TAC std_ss [INTERVAL_SPLIT] THEN
         MESON_TAC [] ] ],
     DISCH_TAC THEN X_GEN_TAC ``xx:real`` THEN X_GEN_TAC ``kk:real->bool`` THEN
     POP_ASSUM (MP_TAC o SPECL [``xx:real``,``kk:real->bool``]) THEN
     MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
     MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL
      [METIS_TAC [PAIR_EQ, GSYM MONO_NOT_EQ], ALL_TAC] THEN
     MATCH_MP_TAC(SET_RULE
      ``s SUBSET s' /\ t SUBSET t'
       ==> (s' INTER t' = {}) ==> (s INTER t = {})``) THEN CONJ_TAC THEN
     MATCH_MP_TAC SUBSET_INTERIOR THEN SIMP_TAC std_ss [INTER_SUBSET] ],
   (* goal 2 (of 2) *)
   MATCH_MP_TAC MONO_AND THEN SIMP_TAC std_ss [IMAGE_FINITE] THEN
   MATCH_MP_TAC MONO_AND THEN
   SIMP_TAC std_ss [RIGHT_FORALL_IMP_THM, IMP_CONJ, FORALL_IN_GSPEC] THEN
   SIMP_TAC std_ss [lemma] THEN CONJ_TAC THEN
   DISCH_TAC THEN X_GEN_TAC ``x:real`` THEN X_GEN_TAC ``k:real->bool`` THEN
   POP_ASSUM (MP_TAC o SPECL [``x:real``,``k:real->bool``]) THEN
   DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC std_ss [] THENL
    [MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
      [SIMP_TAC std_ss [real_ge, IN_INTER, GSPECIFICATION] THEN
       UNDISCH_TAC ``{(x,k) | (x:real,k:real->bool) IN r /\
                     x NOTIN {x | x <= c}} = t`` THEN
       REWRITE_TAC [EXTENSION] THEN
       DISCH_THEN (MP_TAC o SPECL [``(x:real, k:real->bool)``]) THEN
       DISCH_THEN (ASSUME_TAC o ONCE_REWRITE_RULE [EQ_SYM_EQ]) THEN
       UNDISCH_TAC ``(x:real,k:real->bool) IN t`` THEN ASM_REWRITE_TAC [] THEN
       SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN REAL_ARITH_TAC,
       MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
        [SET_TAC[],
         STRIP_TAC THEN ASM_SIMP_TAC std_ss [INTERVAL_SPLIT] THEN MESON_TAC[]]],
     DISCH_TAC THEN X_GEN_TAC ``xx:real`` THEN X_GEN_TAC ``kk:real->bool`` THEN
     POP_ASSUM (MP_TAC o SPECL [``xx:real``,``kk:real->bool``]) THEN
     MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
     MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL
      [METIS_TAC [PAIR_EQ, GSYM MONO_NOT_EQ], ALL_TAC] THEN
     MATCH_MP_TAC(SET_RULE
      ``s SUBSET s' /\ t SUBSET t'
       ==> (s' INTER t' = {}) ==> (s INTER t = {})``) THEN CONJ_TAC THEN
     MATCH_MP_TAC SUBSET_INTERIOR THEN SIMP_TAC std_ss [INTER_SUBSET] ] ]
QED

val EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE = store_thm ("EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE",
 ``!fs f:real->real a b.
        fs equiintegrable_on interval[a,b] /\ f IN fs /\
        (!h x. h IN fs /\ x IN interval[a,b] ==> abs(h x) <= abs(f x))
        ==> { (\x. if x >= c then h x else 0) |
              c IN univ(:real) /\ h IN fs }
            equiintegrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL
   [``{\x. (f:real->real) (-x) | f IN fs}``,
    ``\x. (f:real->real)(-x)``,
    ``-b:real``, ``-a:real``]
        EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE) THEN
  ASM_SIMP_TAC std_ss [EQUIINTEGRABLE_REFLECT] THEN
  KNOW_TAC ``(\(x :real). (f :real -> real) (-x)) IN
 {(\(x :real). f (-x)) | f IN (fs :(real -> real) -> bool)} /\
 (!(h :real -> real) (x :real).
    h IN {(\(x :real). f (-x)) | f IN fs} /\
    x IN interval [(-(b :real),-(a :real))] ==>
    abs (h x) <= abs (f (-x)))`` THENL
   [ASM_SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM, FORALL_IN_GSPEC] THEN
    ONCE_REWRITE_TAC[GSYM IN_INTERVAL_REFLECT] THEN
    ASM_SIMP_TAC std_ss [REAL_NEG_NEG] THEN
    SIMP_TAC real_ss [GSYM IMAGE_DEF, IN_IMAGE] THEN
    EXISTS_TAC ``f:real->real`` THEN ASM_REWRITE_TAC[],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_REFLECT) THEN
    REWRITE_TAC[REAL_NEG_NEG] THEN MATCH_MP_TAC
     (REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN
    SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_GSPEC] THEN
    MAP_EVERY X_GEN_TAC [``c:real``, ``h:real->real``] THEN
    STRIP_TAC THEN SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN EXISTS_TAC
     ``(\x:real. if (-x) >= c then (h:real->real)(-x) else 0:real)`` THEN
    SIMP_TAC std_ss [REAL_NEG_NEG] THEN MAP_EVERY EXISTS_TAC
     [``-c:real``, ``\x. (h:real->real)(-x)``] THEN
    ASM_REWRITE_TAC[IN_UNIV] THEN
    SIMP_TAC std_ss [REAL_ARITH ``-x >= c <=> x <= -c:real``] THEN
    EXISTS_TAC ``h:real->real`` THEN ASM_REWRITE_TAC[]]);

val EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LT = store_thm ("EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LT",
 ``!fs f:real->real a b.
        fs equiintegrable_on interval[a,b] /\ f IN fs /\
        (!h x. h IN fs /\ x IN interval[a,b] ==> abs(h x) <= abs(f x))
        ==> { (\x. if x < c then h x else 0) | c IN univ(:real) /\ h IN fs }
            equiintegrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [``fs:(real->real)->bool``, ``f:real->real``,
                 ``a:real``, ``b:real``]
    EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE) THEN
  ASM_SIMP_TAC std_ss [] THEN UNDISCH_TAC
   ``(fs:(real->real)->bool) equiintegrable_on interval[a,b]`` THEN
  REWRITE_TAC[AND_IMP_INTRO] THEN
  DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_SUB) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN
  SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_GSPEC] THEN
  MAP_EVERY X_GEN_TAC [``c:real``, ``h:real->real``] THEN
  STRIP_TAC THEN SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN
  EXISTS_TAC ``h:real->real`` THEN
  EXISTS_TAC ``\x:real. if x >= c then (h:real->real) x else 0:real`` THEN
  ASM_SIMP_TAC std_ss [] THEN CONJ_TAC THENL
   [SIMP_TAC std_ss [FUN_EQ_THM, real_ge, GSYM REAL_NOT_LT] THEN
    GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [] THEN
    REAL_ARITH_TAC,
    MAP_EVERY EXISTS_TAC [``c:real``, ``h:real->real``] THEN
    ASM_SIMP_TAC std_ss []]);

val EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GT = store_thm ("EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GT",
 ``!fs f:real->real a b.
        fs equiintegrable_on interval[a,b] /\ f IN fs /\
        (!h x. h IN fs /\ x IN interval[a,b] ==> abs(h x) <= abs(f x))
        ==> { (\x. if x > c then h x else 0) | c IN univ(:real) /\ h IN fs }
            equiintegrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [``fs:(real->real)->bool``, ``f:real->real``,
                 ``a:real``, ``b:real``]
    EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE) THEN
  ASM_SIMP_TAC std_ss [] THEN UNDISCH_TAC
   ``(fs:(real->real)->bool) equiintegrable_on interval[a,b]`` THEN
  REWRITE_TAC[AND_IMP_INTRO] THEN
  DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_SUB) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN
  SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_GSPEC] THEN
  MAP_EVERY X_GEN_TAC [``c:real``, ``h:real->real``] THEN
  STRIP_TAC THEN SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN
  EXISTS_TAC ``h:real->real`` THEN
  EXISTS_TAC ``\x. if x <= c then (h:real->real) x else 0`` THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
   [SIMP_TAC std_ss [FUN_EQ_THM, real_gt, GSYM REAL_NOT_LE] THEN
    GEN_TAC THEN COND_CASES_TAC THEN FULL_SIMP_TAC std_ss [] THEN
    REAL_ARITH_TAC,
    MAP_EVERY EXISTS_TAC [``c:real``, ``h:real->real``] THEN
    ASM_SIMP_TAC std_ss []]);

val EQUIINTEGRABLE_OPEN_INTERVAL_RESTRICTIONS = store_thm ("EQUIINTEGRABLE_OPEN_INTERVAL_RESTRICTIONS",
 ``!f:real->real a b.
        f integrable_on interval[a,b]
        ==> { (\x. if x IN interval(c,d) then f x else 0) |
              c IN univ(:real) /\ d IN univ(:real) }
            equiintegrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   ``!n. (\n. n <= (1:num)
        ==> f INSERT
            { (\x. if !i. 1 <= i /\ i <= n ==> c < x /\ x < d
                   then (f:real->real) x else 0) |
              c IN univ(:real) /\ d IN univ(:real) }
            equiintegrable_on interval[a,b]) n``
  MP_TAC THENL
   [MATCH_MP_TAC INDUCTION THEN
    SIMP_TAC std_ss [ARITH_PROVE ``~(1 <= i /\ i <= 0:num)``] THEN
    ASM_SIMP_TAC std_ss [ETA_AX, EQUIINTEGRABLE_ON_SING, SET_RULE
     ``f INSERT {f |(c,d)| c IN UNIV /\ d IN UNIV} = {f}``] THEN
    X_GEN_TAC ``n:num`` THEN ASM_CASES_TAC ``SUC n <= (1:num)`` THEN
    ASM_REWRITE_TAC[] THEN KNOW_TAC ``n <= 1:num`` THENL
    [ASM_ARITH_TAC, DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
     DISCH_THEN(MP_TAC o SPEC ``f:real->real`` o
        MATCH_MP (REWRITE_RULE[IMP_CONJ]
          EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LT)) THEN
    REWRITE_TAC[IN_INSERT] THEN
    KNOW_TAC ``(!(h :real -> real) (x :real).
    (h = (f :real -> real)) \/
    h IN {(\(x :real).
        if !(i :num). (1 :num) <= i /\ i <= (n :num) ==> c < x /\ x < d
        then f x
        else (0 :real)) |
     c IN univ((:real) :real itself) /\
     d IN univ((:real) :real itself)} ==>
    x IN interval [((a :real),(b :real))] ==>
    abs (h x) <= abs (f x))`` THENL
     [REWRITE_TAC[TAUT
       `a \/ b ==> c ==> d <=> (a ==> c ==> d) /\ (b ==> c ==> d)`] THEN
      SIMP_TAC std_ss [REAL_LE_REFL, RIGHT_FORALL_IMP_THM] THEN
      SIMP_TAC std_ss [FORALL_IN_GSPEC] THEN
      REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
      ASM_SIMP_TAC std_ss [ABS_0, REAL_LE_REFL, ABS_POS],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    UNDISCH_TAC ``f integrable_on interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o REWRITE_RULE [GSYM EQUIINTEGRABLE_ON_SING]) THEN
    REWRITE_TAC[AND_IMP_INTRO] THEN
    DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_UNION) THEN
    DISCH_THEN(MP_TAC o SPEC ``f:real->real`` o
        MATCH_MP (REWRITE_RULE[IMP_CONJ]
          EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GT)) THEN
    ASM_SIMP_TAC std_ss [IN_UNION, IN_SING] THEN
    KNOW_TAC ``(!(h :real -> real) (x :real).
    (h = (f :real -> real)) \/
    h IN {(\(x :real). if x < c then h x else (0 :real)) |
     c IN univ((:real) :real itself) /\
     ((h = f) \/
      h IN {(\(x :real).
          if !(i :num). (1 :num) <= i /\ i <= (n :num) ==> c < x /\ x < d
          then f x
          else (0 :real)) |
       c IN univ((:real) :real itself) /\
       d IN univ((:real) :real itself)})} ==>
    x IN interval [((a :real),(b :real))] ==>
    abs (h x) <= abs (f x))`` THENL
     [REWRITE_TAC[TAUT
       `a \/ b ==> c ==> d <=> (a ==> c ==> d) /\ (b ==> c ==> d)`] THEN
      SIMP_TAC std_ss [REAL_LE_REFL, RIGHT_FORALL_IMP_THM] THEN
      SIMP_TAC std_ss [FORALL_IN_GSPEC, LEFT_AND_OVER_OR] THEN
      REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
      SIMP_TAC std_ss [REAL_LE_REFL, RIGHT_FORALL_IMP_THM]  THEN
      SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM, FORALL_IN_GSPEC,
                  FORALL_AND_THM] THEN
      SIMP_TAC std_ss [IN_UNIV] THEN
      REPEAT STRIP_TAC THEN
      REPEAT(COND_CASES_TAC THEN
             ASM_SIMP_TAC std_ss [ABS_0, REAL_LE_REFL, ABS_POS]),
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    FIRST_ASSUM(MP_TAC o REWRITE_RULE [GSYM EQUIINTEGRABLE_ON_SING]) THEN
    REWRITE_TAC[AND_IMP_INTRO] THEN
    DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_UNION) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN
    MATCH_MP_TAC(SET_RULE
      ``s SUBSET t ==> (x INSERT s) SUBSET ({x} UNION t)``) THEN
    SIMP_TAC std_ss [SUBSET_DEF, real_gt, FORALL_IN_GSPEC, IN_UNIV, EXISTS_PROD] THEN
    MAP_EVERY X_GEN_TAC [``c:real``, ``d:real``] THEN
    SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN
    EXISTS_TAC ``(c:real)`` THEN ONCE_REWRITE_TAC [CONJ_SYM] THEN
    KNOW_TAC ``?(p_2 :real -> real).
  ((p_2 = (f :real -> real)) \/
   ?(p_1 :real) (p_2' :real -> real).
     (\p_1 p_2'. (p_2' = f) \/
       ?(p_1 :real) (p_2 :real).
        p_2' =
        (\(x :real).
           if
             !(i :num).
               (1 :num) <= i /\ i <= (n :num) ==> p_1 < x /\ x < p_2
           then
             f x
           else (0 :real))) p_1 p_2' /\
       (p_2 = (\p_1 p_2'. (\(x :real). if x < p_1 then p_2' x else (0 :real))) p_1 p_2')) /\
  (\p_2. ((\(x :real).
      if
        !(i :num).
          (1 :num) <= i /\ i <= SUC n ==> (c :real) < x /\ x < (d :real)
      then
        f x
      else (0 :real)) =
   (\(x :real). if c < x then p_2 x else (0 :real)))) p_2`` THENL
    [ALL_TAC, SIMP_TAC std_ss [CONJ_SYM]] THEN
    MATCH_MP_TAC(METIS[]
     ``(?c k. P c k /\ Q (g c k))
       ==> ?h. ((h = f) \/ (?c k. P c k /\ (h = g c k))) /\ Q h``) THEN
    EXISTS_TAC ``(d:real)`` THEN
    EXISTS_TAC
     ``\x. if !i. 1 <= i /\ i <= n:num ==> (c:real) < x /\ x < (d:real)
          then (f:real->real) x else 0`` THEN
    SIMP_TAC std_ss [] THEN CONJ_TAC THENL
     [DISJ2_TAC THEN
      MAP_EVERY EXISTS_TAC [``c:real``, ``d:real``] THEN SIMP_TAC std_ss [],
      SIMP_TAC std_ss [FUN_EQ_THM, LE] THEN
      METIS_TAC[ARITH_PROVE ``1 <= SUC n``]],
    DISCH_THEN(MP_TAC o SPEC ``1:num``) THEN
    SIMP_TAC std_ss [IN_INTERVAL, LESS_EQ_REFL] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN
    SIMP_TAC std_ss [IN_INSERT, SUBSET_DEF, GSPECIFICATION, EXISTS_PROD] THEN
    REPEAT STRIP_TAC THEN ASM_CASES_TAC ``x = f:real->real`` THEN
    ASM_SIMP_TAC std_ss [] THEN EXISTS_TAC ``p_1:real`` THEN
    EXISTS_TAC ``p_2:real`` THEN ASM_SIMP_TAC std_ss [FUN_EQ_THM] THEN
    X_GEN_TAC ``y:real`` THEN COND_CASES_TAC THEN ASM_SIMP_TAC arith_ss []]);

val EQUIINTEGRABLE_CLOSED_INTERVAL_RESTRICTIONS = store_thm ("EQUIINTEGRABLE_CLOSED_INTERVAL_RESTRICTIONS",
 ``!f:real->real a b.
        f integrable_on interval[a,b]
        ==> { (\x. if x IN interval[c,d] then f x else 0) |
              c IN univ(:real) /\ d IN univ(:real) }
            equiintegrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   ``!n. (\n. n <= (1:num)
        ==> f INSERT
            { (\x. if !i. 1 <= i /\ i <= n ==> c <= x /\ x <= d
                   then (f:real->real) x else 0) |
              c IN univ(:real) /\ d IN univ(:real) }
            equiintegrable_on interval[a,b]) n``
  MP_TAC THENL
   [MATCH_MP_TAC INDUCTION THEN
    REWRITE_TAC[ARITH_PROVE ``~(1 <= i /\ i <= 0:num)``] THEN
    ASM_SIMP_TAC std_ss [ETA_AX, EQUIINTEGRABLE_ON_SING, SET_RULE
     ``f INSERT {f |(c,d)| c IN UNIV /\ d IN UNIV} = {f}``] THEN
    X_GEN_TAC ``n:num`` THEN ASM_CASES_TAC ``SUC n <= (1:num)`` THEN
    ASM_SIMP_TAC std_ss [] THEN KNOW_TAC ``n <= 1:num`` THENL
    [ASM_SIMP_TAC arith_ss [], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    DISCH_THEN(MP_TAC o SPEC ``f:real->real`` o
        MATCH_MP (REWRITE_RULE[IMP_CONJ]
          EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE)) THEN
    SIMP_TAC std_ss [IN_INSERT] THEN
    KNOW_TAC ``(!(h :real -> real) (x :real).
    (h = (f :real -> real)) \/
    h IN {(\(x :real).
        if !(i :num). (1 :num) <= i /\ i <= (n :num) ==> c <= x /\ x <= d
        then f x
        else (0 :real)) |
     c IN univ((:real) :real itself) /\
     d IN univ((:real) :real itself)} ==>
    x IN interval [(a :real),(b :real)] ==>
    abs (h x) <= abs (f x))`` THENL
     [REWRITE_TAC[TAUT
       `a \/ b ==> c ==> d <=> (a ==> c ==> d) /\ (b ==> c ==> d)`] THEN
      SIMP_TAC std_ss [REAL_LE_REFL, RIGHT_FORALL_IMP_THM] THEN
      SIMP_TAC std_ss [FORALL_IN_GSPEC] THEN
      REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
      ASM_SIMP_TAC std_ss [ABS_0, REAL_LE_REFL, ABS_POS],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    UNDISCH_TAC ``f integrable_on interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o REWRITE_RULE [GSYM EQUIINTEGRABLE_ON_SING]) THEN
    REWRITE_TAC[AND_IMP_INTRO] THEN
    DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_UNION) THEN
    DISCH_THEN(MP_TAC o SPEC ``f:real->real`` o
        MATCH_MP (REWRITE_RULE[IMP_CONJ]
          EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE)) THEN
    ASM_SIMP_TAC std_ss [IN_UNION, IN_SING] THEN
    KNOW_TAC ``(!(h :real -> real) (x :real).
    (h = (f :real -> real)) \/
    h IN {(\(x :real). if x <= c then h x else (0 :real)) |
     c IN univ((:real) :real itself) /\
     ((h = f) \/
      h IN {(\(x :real).
          if !(i :num). (1 :num) <= i /\ i <= (n :num) ==> c <= x /\ x <= d
          then f x
          else (0 :real)) |
       c IN univ((:real) :real itself) /\
       d IN univ((:real) :real itself)})} ==>
    x IN interval [((a :real),(b :real))] ==>
    abs (h x) <= abs (f x))`` THENL
     [REWRITE_TAC[TAUT
       `a \/ b ==> c ==> d <=> (a ==> c ==> d) /\ (b ==> c ==> d)`] THEN
      SIMP_TAC std_ss [REAL_LE_REFL, RIGHT_FORALL_IMP_THM] THEN
      SIMP_TAC std_ss [FORALL_IN_GSPEC, LEFT_AND_OVER_OR] THEN
      REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
      SIMP_TAC std_ss [REAL_LE_REFL, RIGHT_FORALL_IMP_THM]  THEN
      SIMP_TAC std_ss [IMP_CONJ, RIGHT_FORALL_IMP_THM, FORALL_IN_GSPEC,
                  FORALL_AND_THM] THEN
      SIMP_TAC std_ss [IN_UNIV] THEN
      REPEAT STRIP_TAC THEN
      REPEAT(COND_CASES_TAC THEN
             ASM_SIMP_TAC std_ss [ABS_0, REAL_LE_REFL, ABS_POS]),
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    FIRST_ASSUM(MP_TAC o REWRITE_RULE [GSYM EQUIINTEGRABLE_ON_SING]) THEN
    REWRITE_TAC[AND_IMP_INTRO] THEN
    DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_UNION) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN
    MATCH_MP_TAC(SET_RULE
      ``s SUBSET t ==> (x INSERT s) SUBSET ({x} UNION t)``) THEN
    SIMP_TAC std_ss [SUBSET_DEF, real_gt, FORALL_IN_GSPEC, IN_UNIV, EXISTS_PROD] THEN
    MAP_EVERY X_GEN_TAC [``c:real``, ``d:real``] THEN
    SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN
    EXISTS_TAC ``(c:real)`` THEN ONCE_REWRITE_TAC [CONJ_SYM] THEN
    KNOW_TAC ``?(p_2 :real -> real).
  ((p_2 = (f :real -> real)) \/
   ?(p_1 :real) (p_2' :real -> real).
     (\p_1 p_2'. (p_2' = f) \/
       ?(p_1 :real) (p_2 :real).
        p_2' =
        (\(x :real).
           if
             !(i :num).
               (1 :num) <= i /\ i <= (n :num) ==> p_1 <= x /\ x <= p_2
           then
             f x
           else (0 :real))) p_1 p_2' /\
       (p_2 = (\p_1 p_2'. (\(x :real). if x <= p_1 then p_2' x else (0 :real))) p_1 p_2')) /\
  (\p_2. ((\(x :real).
      if
        !(i :num).
          (1 :num) <= i /\ i <= SUC n ==> (c :real) <= x /\ x <= (d :real)
      then
        f x
      else (0 :real)) =
   (\(x :real). if x >= c then p_2 x else (0 :real)))) p_2`` THENL
    [ALL_TAC, SIMP_TAC std_ss [CONJ_SYM]] THEN
    MATCH_MP_TAC(METIS[]
     ``(?c k. P c k /\ Q (g c k))
      ==> ?h. ((h = f) \/ ?c k. P c k /\ (h = g c k)) /\ Q h``) THEN
    EXISTS_TAC ``(d:real)`` THEN
    EXISTS_TAC
     ``\x. if !i. 1 <= i /\ i <= n:num ==> (c:real) <= x /\ x <= (d:real)
          then (f:real->real) x else 0`` THEN
    SIMP_TAC std_ss [] THEN CONJ_TAC THENL
     [DISJ2_TAC THEN
      MAP_EVERY EXISTS_TAC [``c:real``, ``d:real``] THEN SIMP_TAC std_ss [],
      SIMP_TAC std_ss [FUN_EQ_THM, LE, real_ge] THEN
      METIS_TAC[ARITH_PROVE ``1 <= SUC n``]],
    DISCH_THEN(MP_TAC o SPEC ``1:num``) THEN
    SIMP_TAC std_ss [IN_INTERVAL, LESS_EQ_REFL] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN
    SIMP_TAC std_ss [IN_INSERT, SUBSET_DEF, GSPECIFICATION, EXISTS_PROD] THEN
    REPEAT STRIP_TAC THEN ASM_CASES_TAC ``x = f:real->real`` THEN
    ASM_SIMP_TAC std_ss [] THEN EXISTS_TAC ``p_1:real`` THEN
    EXISTS_TAC ``p_2:real`` THEN ASM_SIMP_TAC std_ss [FUN_EQ_THM] THEN
    X_GEN_TAC ``y:real`` THEN COND_CASES_TAC THEN ASM_SIMP_TAC arith_ss []]);

(* ------------------------------------------------------------------------- *)
(* Continuity of the indefinite integral.                                    *)
(* ------------------------------------------------------------------------- *)

val INDEFINITE_INTEGRAL_CONTINUOUS = store_thm ("INDEFINITE_INTEGRAL_CONTINUOUS",
 ``!f:real->real a b c d e.
        f integrable_on interval[a,b] /\
        c IN interval[a,b] /\ d IN interval[a,b] /\ &0 < e
        ==> ?k. &0 < k /\
                !c' d'. c' IN interval[a,b] /\
                        d' IN interval[a,b] /\
                        abs(c' - c) <= k /\ abs(d' - d) <= k
                        ==> abs(integral(interval[c',d']) f -
                                 integral(interval[c,d]) f) < e``,
  REPEAT STRIP_TAC THEN
  KNOW_TAC ``~(!(k :real).
  (0 :real) < k ==>
  ~(!(c' :real) (d' :real).
    c' IN interval [((a :real),(b :real))] /\ d' IN interval [(a,b)] /\
    abs (c' - (c :real)) <= k /\ abs (d' - (d :real)) <= k ==>
    abs
      (integral (interval [(c',d')]) (f :real -> real) -
       integral (interval [(c,d)]) f) < (e :real)))`` THENL
  [ALL_TAC, METIS_TAC []] THEN
  DISCH_THEN(MP_TAC o GEN ``n:num`` o SPEC ``inv(&n + &1:real)``) THEN
  DISCH_THEN (MP_TAC o SIMP_RULE std_ss [NOT_FORALL_THM, NOT_IMP]) THEN
  REWRITE_TAC [REAL_LT_INV_EQ, METIS [REAL_LT, REAL_OF_NUM_ADD, GSYM ADD1, LESS_0]
    ``&0 < &n + &1:real``] THEN
  KNOW_TAC ``!c' d'.
       ~(!n:num. (c' n IN interval [a,b] /\
            d' n IN interval [a,b] /\
            abs (c' n - c) <= inv (&n + &1) /\
            abs (d' n - d) <= inv (&n + &1)) /\
           ~(abs (integral (interval [c' n,d' n]) f -
              integral (interval [c,d]) f) < e:real))`` THENL
  [ALL_TAC, METIS_TAC [SKOLEM_THM]] THEN
  REWRITE_TAC [REAL_NOT_LT, GSYM CONJ_ASSOC] THEN
  MAP_EVERY X_GEN_TAC [``u:num->real``, ``v:num->real``] THEN
  DISCH_THEN (MP_TAC o SIMP_RULE std_ss [FORALL_AND_THM]) THEN
  STRIP_TAC THEN
  ABBREV_TAC
   ``k:real->bool =
     BIGUNION (IMAGE (\i. {x | x = (c:real)} UNION {x | x = (d:real)})
                  ((1:num)..(1:num)))`` THEN
  SUBGOAL_THEN ``negligible(k:real->bool)`` ASSUME_TAC THENL
   [EXPAND_TAC "k" THEN MATCH_MP_TAC NEGLIGIBLE_BIGUNION THEN
    SIMP_TAC std_ss [IMAGE_FINITE, FINITE_NUMSEG, FORALL_IN_IMAGE] THEN
    X_GEN_TAC ``i:num`` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN
    ASM_SIMP_TAC std_ss [NEGLIGIBLE_UNION, NEGLIGIBLE_STANDARD_HYPERPLANE],
    ALL_TAC] THEN
  MP_TAC(ISPECL
   [``\n:num x. if x IN interval[u n,v n] then
                 if x IN k then 0 else (f:real->real) x
               else 0``,
    ``\x. if x IN interval[c,d] then
            if x IN k then 0 else (f:real->real) x
         else 0``,
    ``a:real``, ``b:real``] EQUIINTEGRABLE_LIMIT) THEN
  SIMP_TAC std_ss [NOT_IMP] THEN REPEAT CONJ_TAC THENL
   [SUBGOAL_THEN
     ``(\x. if x IN k then 0 else (f:real->real) x)
      integrable_on interval[a,b]``
    MP_TAC THENL
     [UNDISCH_TAC ``(f:real->real) integrable_on interval[a,b]`` THEN
      MATCH_MP_TAC INTEGRABLE_SPIKE THEN EXISTS_TAC ``k:real->bool`` THEN
      ASM_REWRITE_TAC[] THEN SET_TAC[],
      ALL_TAC] THEN
    DISCH_THEN(MP_TAC o MATCH_MP
      EQUIINTEGRABLE_CLOSED_INTERVAL_RESTRICTIONS) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN
    SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_GSPEC, IN_UNIV] THEN
    SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN
    X_GEN_TAC ``n:num`` THEN MAP_EVERY EXISTS_TAC
     [``(u:num->real) n``, ``(v:num->real) n``] THEN
    SIMP_TAC std_ss [],
    X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN
    ASM_CASES_TAC ``(x:real) IN k`` THEN
    ASM_SIMP_TAC std_ss [COND_ID, LIM_CONST] THEN MATCH_MP_TAC LIM_EVENTUALLY THEN
    SIMP_TAC std_ss [EVENTUALLY_SEQUENTIALLY] THEN
    MP_TAC(SPEC ``inf (IMAGE (\i. min (abs((x:real) - (c:real)))
                                     (abs((x:real) - (d:real))))
                            ((1:num)..(1:num)))`` REAL_ARCH_INV) THEN
    SIMP_TAC std_ss [REAL_LT_INF_FINITE, IMAGE_FINITE, IMAGE_EQ_EMPTY,
             FINITE_NUMSEG, NUMSEG_EMPTY, NOT_LESS] THEN
    ASM_SIMP_TAC std_ss [FORALL_IN_IMAGE, REAL_LT_MIN, IN_NUMSEG] THEN
    UNDISCH_TAC ``~((x:real) IN k)`` THEN EXPAND_TAC "k" THEN
    SIMP_TAC std_ss [BIGUNION_IMAGE, GSPECIFICATION, NOT_EXISTS_THM] THEN
    REWRITE_TAC[IN_NUMSEG, SET_RULE
     ``~p \/ x NOTIN (s UNION t) <=> p ==> ~(x IN s) /\ ~(x IN t)``] THEN
    SIMP_TAC std_ss [GSPECIFICATION, REAL_ARITH ``&0 < abs(x - y) <=> ~(x = y:real)``] THEN
    DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN EXISTS_TAC ``N:num`` THEN
    POP_ASSUM MP_TAC THEN STRIP_TAC THEN
    X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN
    SUBGOAL_THEN ``x IN interval[(u:num->real) n,v n] <=> x IN interval[c,d]``
     (fn th => SIMP_TAC std_ss [th]) THEN
    REWRITE_TAC[IN_INTERVAL] THEN
    POP_ASSUM MP_TAC THEN POP_ASSUM (MP_TAC o SPEC ``1:num``) THEN
    SIMP_TAC arith_ss [] THEN REPEAT STRIP_TAC THEN
    MATCH_MP_TAC(REAL_ARITH
     ``!N n. abs(u - c) <= n /\ abs(v - d) <= n /\
            N < abs(x - c) /\ N < abs(x - d) /\ n <= N
      ==> (u <= x /\ x <= v <=> c <= x /\ x <= d:real)``) THEN
    MAP_EVERY EXISTS_TAC [``inv(&N:real)``, ``inv(&n + &1:real)``] THEN
    ASM_SIMP_TAC std_ss [] THEN
    MATCH_MP_TAC REAL_LE_INV2 THEN
    REWRITE_TAC[REAL_OF_NUM_ADD, REAL_OF_NUM_LE, REAL_LT] THEN
    ASM_SIMP_TAC arith_ss [],
    CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN POP_ASSUM MP_TAC THEN
    SIMP_TAC std_ss [INTEGRAL_RESTRICT_INTER] THEN
    SUBGOAL_THEN
     ``(interval[c:real,d] INTER interval[a,b] = interval[c,d]) /\
      !n:num. interval[u n,v n] INTER interval[a,b] = interval[u n,v n]``
     (fn th => SIMP_TAC std_ss [th])
    THENL
     [REWRITE_TAC[SET_RULE ``(s INTER t = s) <=> s SUBSET t``] THEN
      REWRITE_TAC[SUBSET_INTERVAL] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_MESON_TAC[],
      ALL_TAC] THEN
    REWRITE_TAC[LIM_SEQUENTIALLY] THEN
    DISCH_THEN(MP_TAC o SPEC ``e:real``) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN ``N:num`` (MP_TAC o SPEC ``N:num``)) THEN
    REWRITE_TAC[LESS_EQ_REFL, REAL_NOT_LT] THEN REWRITE_TAC [dist] THEN
    FIRST_ASSUM(fn th => MP_TAC(SPEC ``N:num`` th) THEN MATCH_MP_TAC
    (REAL_ARITH ``(x = a) /\ (y = b) ==> e <= abs(x - y) ==> e <= abs(a - b:real)``)) THEN
    CONJ_TAC THEN SIMP_TAC std_ss [] THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN
    EXISTS_TAC ``k:real->bool`` THEN ASM_SIMP_TAC std_ss [IN_DIFF]]);;

val INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT = store_thm ("INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT",
 ``!f:real->real a b.
        f integrable_on interval[a,b]
         ==> (\x. integral (interval[a,x]) f) continuous_on interval[a,b]``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN REWRITE_TAC[continuous_within] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``b:real``,
                 ``a:real``, ``x:real``, ``e:real``]
        INDEFINITE_INTEGRAL_CONTINUOUS) THEN
  ASM_SIMP_TAC std_ss [ENDS_IN_INTERVAL] THEN
  KNOW_TAC ``interval [(a,b:real)] <> {}`` THENL
  [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
   POP_ASSUM K_TAC THEN REWRITE_TAC[dist]] THEN
  DISCH_THEN (X_CHOOSE_TAC ``d:real``) THEN EXISTS_TAC ``d:real`` THEN
  POP_ASSUM MP_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_SIMP_TAC std_ss [ENDS_IN_INTERVAL, REAL_SUB_REFL, ABS_0, REAL_LT_IMP_LE] THEN
  ASM_SET_TAC[]);

val INDEFINITE_INTEGRAL_CONTINUOUS_LEFT = store_thm ("INDEFINITE_INTEGRAL_CONTINUOUS_LEFT",
 ``!f:real->real a b.
        f integrable_on interval[a,b]
        ==> (\x. integral(interval[x,b]) f) continuous_on interval[a,b]``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN REWRITE_TAC[continuous_within] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``b:real``,
                 ``x:real``, ``b:real``, ``e:real``]
        INDEFINITE_INTEGRAL_CONTINUOUS) THEN
  ASM_SIMP_TAC std_ss [ENDS_IN_INTERVAL] THEN
  KNOW_TAC ``interval [(a,b:real)] <> {}`` THENL
  [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
   POP_ASSUM K_TAC THEN REWRITE_TAC[dist]] THEN
  DISCH_THEN (X_CHOOSE_TAC ``d:real``) THEN EXISTS_TAC ``d:real`` THEN
  POP_ASSUM MP_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_SIMP_TAC std_ss [ENDS_IN_INTERVAL, REAL_SUB_REFL, ABS_0, REAL_LT_IMP_LE] THEN
  ASM_SET_TAC[]);

(* ------------------------------------------------------------------------- *)
(* Second mean value theorem and corollaries.                                *)
(* ------------------------------------------------------------------------- *)

val lemma1 = prove (
   ``!f:real->real s.
      (!x. x IN s ==> &0 <= f x /\ f x <= &1)
      ==> (!n x. x IN s /\ ~(n = 0)
                 ==> abs(f x -
                         sum((1:num)..n) (\k. if &k / &n <= f(x)
                                        then inv(&n) else &0)) < inv(&n))``,
    REPEAT STRIP_TAC THEN
    SUBGOAL_THEN ``?m. flr(&n * (f:real->real) x) = &m`` CHOOSE_TAC THENL
     [MATCH_MP_TAC FLOOR_POS THEN ASM_SIMP_TAC std_ss [REAL_LE_MUL, REAL_POS],
      ALL_TAC] THEN
    SUBGOAL_THEN ``!k. &k / &n <= (f:real->real) x <=> k <= m`` ASSUME_TAC THENL
     [FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
      KNOW_TAC ``0 <= &n * (f:real->real) x`` THENL
      [MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC std_ss [REAL_POS],
       DISCH_TAC] THEN
      ASM_SIMP_TAC std_ss [NUM_FLOOR_LE2] THEN
      REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN
      ASM_SIMP_TAC std_ss [REAL_LE_LDIV_EQ, REAL_LT, LE_1] THEN
      SIMP_TAC std_ss [REAL_MUL_SYM],
      ALL_TAC] THEN
    ASM_REWRITE_TAC [] THEN
    ONCE_REWRITE_TAC [METIS []
     ``sum (1 .. n) (\k. if k <= m then inv (&n) else 0) =
       sum (1 .. n) (\k. if (\k. k <= m) k then (\k. inv (&n)) k else 0)``] THEN
    ASM_REWRITE_TAC[GSYM SUM_RESTRICT_SET] THEN SIMP_TAC std_ss [] THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``n + 1:num``) THEN
    REWRITE_TAC [GSYM REAL_OF_NUM_ADD, real_div, REAL_ADD_RDISTRIB] THEN
    ASM_SIMP_TAC real_ss [REAL_MUL_RINV, REAL_MUL_LID, REAL_OF_NUM_EQ] THEN
    ASM_SIMP_TAC real_ss [REAL_ARITH ``y <= &1 /\ &0 < i ==> ~(&1 + i <= y:real)``,
                 REAL_LT_INV_EQ, REAL_LT, LE_1, NOT_LESS_EQUAL] THEN
    SIMP_TAC arith_ss [IN_NUMSEG, ARITH_PROVE
     ``m < n + 1 ==> ((1 <= k /\ k <= n) /\ k <= m <=> 1 <= k /\ k <= m:num)``] THEN
    DISCH_TAC THEN REWRITE_TAC[GSYM numseg, SUM_CONST_NUMSEG, ADD_SUB] THEN
    MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC ``abs(&n:real)`` THEN
    REWRITE_TAC[GSYM ABS_MUL] THEN
    ASM_SIMP_TAC real_ss [ABS_N, REAL_MUL_RINV, REAL_OF_NUM_EQ] THEN
    ASM_SIMP_TAC std_ss [REAL_LT, LE_1, REAL_SUB_LDISTRIB, GSYM real_div] THEN
    ASM_SIMP_TAC real_ss [REAL_DIV_LMUL, REAL_OF_NUM_EQ] THEN
    MATCH_MP_TAC(REAL_ARITH ``f <= x /\ x < f + &1 ==> abs(x - f) < &1:real``) THEN
    FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN CONJ_TAC THENL
    [MATCH_MP_TAC NUM_FLOOR_LE THEN MATCH_MP_TAC REAL_LE_MUL THEN
     ASM_SIMP_TAC std_ss [REAL_POS],
     REWRITE_TAC [GSYM NUM_FLOOR_LET] THEN SIMP_TAC std_ss [REAL_LE_REFL]]);

val lemma2 = prove (
   ``!f:real->real g a b.
          f integrable_on interval[a,b] /\
          (!x y. x <= y ==> g(x) <= g(y))
          ==> {(\x. if c <= g(x) then f x else 0) | c IN univ(:real)}
              equiintegrable_on interval[a,b]``,
    REPEAT STRIP_TAC THEN
    UNDISCH_TAC ``f integrable_on interval [(a,b)]`` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o REWRITE_RULE [GSYM EQUIINTEGRABLE_ON_SING]) THEN
    DISCH_THEN(fn th =>
     MP_TAC(SPEC ``f:real->real`` (MATCH_MP (REWRITE_RULE[IMP_CONJ]
       EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE) th)) THEN
     MP_TAC(SPEC ``f:real->real`` (MATCH_MP (REWRITE_RULE[IMP_CONJ]
       EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GT) th)) THEN
      MP_TAC th) THEN
    SIMP_TAC std_ss [IN_SING, REAL_LE_REFL] THEN
    SUBGOAL_THEN ``{(\x. 0):real->real} equiintegrable_on interval[a,b]``
    MP_TAC THENL
     [REWRITE_TAC[EQUIINTEGRABLE_ON_SING, INTEGRABLE_CONST], ALL_TAC] THEN
    REPEAT(ONCE_REWRITE_TAC[AND_IMP_INTRO] THEN
           DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_UNION)) THEN
    SIMP_TAC std_ss [NUMSEG_SING, IN_SING] THEN
    REWRITE_TAC[SET_RULE ``
     {(\x. if x > c then h x else 0) | c IN univ(:real) /\ (h = f)} =
     {(\x. if x > c then (f:real->real) x else 0) | c IN univ(:real)}``] THEN
    REWRITE_TAC[SET_RULE ``
     {(\x. if x >= c then h x else 0) | c IN univ(:real) /\ (h = f)} =
     {(\x. if x >= c then (f:real->real) x else 0) | c IN univ(:real)}``] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN
    SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_GSPEC, IN_UNIV] THEN
    X_GEN_TAC ``y:real`` THEN
    ASM_CASES_TAC ``!x. y <= (g:real->real) x`` THENL
     [ASM_SIMP_TAC std_ss [ETA_AX, IN_UNION, IN_SING], ALL_TAC] THEN
    ASM_CASES_TAC ``!x. ~(y <= (g:real->real) x)`` THENL
     [ASM_SIMP_TAC std_ss [ETA_AX, IN_UNION, IN_SING], ALL_TAC] THEN
    MP_TAC (ISPEC ``IMAGE (\x. x) {x | y <= (g:real->real) x}`` INF) THEN
    SIMP_TAC std_ss [FORALL_IN_IMAGE, GSPECIFICATION, IMAGE_EQ_EMPTY] THEN
    KNOW_TAC ``({x | y <= (g:real->real) x} <> {}) /\
               (?b. !x. y <= (g:real->real) x ==> b <= x)`` THENL
     [ASM_SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, NOT_IN_EMPTY] THEN
      METIS_TAC[REAL_LE_TRANS, REAL_LE_TOTAL],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
      STRIP_TAC THEN REWRITE_TAC[real_gt, real_ge]] THEN
    REWRITE_TAC[IN_UNION, GSYM DISJ_ASSOC] THEN
    ASM_CASES_TAC ``y <= g((inf(IMAGE (\x. x) {x | y <= (g:real->real) x})))`` THENL
     [REPEAT DISJ2_TAC, DISJ2_TAC THEN DISJ2_TAC THEN DISJ1_TAC] THEN
    SIMP_TAC std_ss [GSPECIFICATION] THEN
    EXISTS_TAC ``inf(IMAGE (\x. x) {x | y <= (g:real->real) x})`` THEN
    SIMP_TAC std_ss [FUN_EQ_THM] THEN
    ONCE_REWRITE_TAC [METIS [] ``y <= g x <=> (\x. y <= (g:real->real) x) x``] THEN
    ONCE_REWRITE_TAC [METIS []
     ``inf (IMAGE (\x. x) {x | (\x. y <= (g:real->real) x) x}) <= x <=>
       (\x. inf (IMAGE (\x. x) {x | (\x. y <= g x) x}) <= x) x``] THEN
    MATCH_MP_TAC(METIS []
     ``(!x. P x <=> Q x)
      ==> !x. (if P x then f x else b) = (if Q x then f x else b)``) THEN
    X_GEN_TAC ``x:real`` THEN SIMP_TAC std_ss [GSYM REAL_NOT_LE] THEN
    METIS_TAC [REAL_LE_TOTAL, REAL_LT_ANTISYM, REAL_LE_TRANS]);

val lemma3 = prove (
   ``!f:real->real g:real->real a b.
          f integrable_on interval[a,b] /\
          (!x y. x <= y ==> g(x) <= g(y))
          ==> {(\x. sum ((1:num)..n)
                     (\k. if &k / &n <= g x then inv(&n) * f(x) else 0)) |
               ~(n = 0)}
              equiintegrable_on interval[a,b]``,
    REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o
     MATCH_MP lemma2) THEN
    DISCH_THEN(MP_TAC o MATCH_MP
     (INST_TYPE [alpha |-> ``:num``] (EQUIINTEGRABLE_SUM))) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN
    SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_GSPEC, IN_UNIV] THEN X_GEN_TAC ``n:num`` THEN
    DISCH_TAC THEN SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN
    MAP_EVERY EXISTS_TAC [``((1:num)..n)``, ``(\k:num. inv(&n:real))``,
     ``(\k x. if &k / &n <= (g:real->real) x then (f:real->real) x else 0)``] THEN
    ASM_SIMP_TAC real_ss [SUM_CONST_NUMSEG, ADD_SUB, REAL_MUL_RINV, REAL_OF_NUM_EQ] THEN
    SIMP_TAC std_ss [FINITE_NUMSEG, COND_RAND, COND_RATOR, REAL_MUL_RZERO] THEN
    X_GEN_TAC ``k:num`` THEN
    REWRITE_TAC[IN_NUMSEG, REAL_LE_INV_EQ, REAL_POS] THEN STRIP_TAC THEN
    EXISTS_TAC ``&k / &n:real`` THEN SIMP_TAC std_ss []);

val lemma4 = prove (
   ``!f:real->real g:real->real a b.
          ~(interval[a,b] = {}) /\
          f integrable_on interval[a,b] /\
          (!x y. x <= y ==> g(x) <= g(y)) /\
          (!x. x IN interval[a,b] ==> &0 <= g x /\ g x <= &1)
          ==> (\x. g(x) * f(x)) integrable_on interval[a,b] /\
              ?c. c IN interval[a,b] /\
                  (integral (interval[a,b]) (\x. g(x) * f(x)) =
                   integral (interval[c,b]) f)``,
    REPEAT GEN_TAC THEN STRIP_TAC THEN
    SUBGOAL_THEN
     ``?m M. IMAGE (\x. integral (interval[x,b]) (f:real->real))
                  (interval[a,b]) = interval[m,M]``
    STRIP_ASSUME_TAC THENL
     [REWRITE_TAC[GSYM CONNECTED_COMPACT_INTERVAL_1] THEN CONJ_TAC THENL
       [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE,
        MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE] THEN
      ASM_SIMP_TAC std_ss [INDEFINITE_INTEGRAL_CONTINUOUS_LEFT, CONVEX_CONNECTED,
                   CONVEX_INTERVAL, COMPACT_INTERVAL],
      ALL_TAC] THEN
    MP_TAC(ISPECL[``f:real->real``, ``g:real->real``, ``a:real``, ``b:real``]
          lemma3) THEN
    ASM_SIMP_TAC std_ss [] THEN DISCH_TAC THEN
    SUBGOAL_THEN
     ``!n. ?c. c IN interval[a,b] /\
             (integral (interval[c,b]) (f:real->real) =
              integral (interval[a,b])
                (\x. sum ((1:num)..n)
                    (\k. if &k / &n <= (g:real->real) x then inv(&n) * f x else 0)))``
    MP_TAC THENL
    [ (* goal 1 (of 2) *)
      X_GEN_TAC ``n:num`` THEN ASM_CASES_TAC ``n = 0:num`` THENL
       [ASM_SIMP_TAC arith_ss [SUM_CLAUSES_NUMSEG, INTEGRAL_0] THEN
        EXISTS_TAC ``b:real`` THEN ASM_SIMP_TAC std_ss [ENDS_IN_INTERVAL] THEN
        SIMP_TAC std_ss [INTEGRAL_NULL, CONTENT_EQ_0, REAL_LE_REFL],
        ALL_TAC] THEN
      MP_TAC(ISPECL [``f:real->real``, ``g:real->real``,
                     ``a:real``, ``b:real``] lemma2) THEN
      ASM_SIMP_TAC std_ss [equiintegrable_on, FORALL_IN_GSPEC, IN_UNIV] THEN
      DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN
      REWRITE_TAC[METIS [REAL_MUL_RZERO]
       ``(if p then a * x else 0:real) =
         a * (if p then x else 0)``] THEN
      ASM_SIMP_TAC std_ss [SUM_LMUL, INTEGRAL_CMUL, INTEGRABLE_SUM, ETA_AX,
                   FINITE_NUMSEG, INTEGRAL_SUM] THEN
      SUBGOAL_THEN
       ``!y:real. ?d:real.
          d IN interval[a,b] /\
         (integral (interval[a,b]) (\x. if y <= (g:real->real) x then f x else 0) =
          integral (interval[d,b]) (f:real->real))``
      MP_TAC THENL
      [ (* goal 1.1 (of 2) *)
        X_GEN_TAC ``y:real`` THEN
        SUBGOAL_THEN
        ``({x | y <= (g:real->real) x} = {}) \/
          ({x | y <= (g:real->real) x} = univ(:real)) \/
          (?a. {x | y <= (g:real->real) x} = {x | a <= x}) \/
          (?a. {x | y <= (g:real->real) x} = {x | a < x})``
        MP_TAC THENL
        [ (* goal 1.1.1 (of 2) *)
          MATCH_MP_TAC(TAUT `(~a /\ ~b ==> c \/ d) ==> a \/ b \/ c \/ d`) THEN
          DISCH_TAC THEN
          MP_TAC(ISPEC ``IMAGE (\x. x) {x | y <= (g:real->real) x}`` INF) THEN
          ASM_SIMP_TAC real_ss [FORALL_IN_IMAGE, GSPECIFICATION, IMAGE_EQ_EMPTY] THEN
          KNOW_TAC ``(?b'. !x. y <= (g:real->real) x ==> b' <= x)`` THENL
           [FIRST_ASSUM(MP_TAC o CONJUNCT2) THEN
            SIMP_TAC std_ss [EXTENSION, GSPECIFICATION, IN_UNIV, NOT_IN_EMPTY] THEN
            METIS_TAC[REAL_LE_TRANS, REAL_LE_TOTAL],
            DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
            STRIP_TAC] THEN
          ASM_CASES_TAC ``y <= (g:real->real)((inf(IMAGE (\x. x) {x | y <= g x})))`` THENL
           [DISJ1_TAC, DISJ2_TAC] THEN
          SIMP_TAC std_ss [EXTENSION, GSPECIFICATION] THEN
          EXISTS_TAC ``inf(IMAGE (\x. x) {x | y <= (g:real->real) x})`` THEN
          SIMP_TAC std_ss [FUN_EQ_THM] THEN
          X_GEN_TAC ``x:real`` THEN
          REWRITE_TAC[GSYM REAL_NOT_LE] THEN
          METIS_TAC[REAL_LE_TOTAL, REAL_LT_ANTISYM, REAL_LE_TRANS],
          (* goal 1.1.2 (of 2) *)
          SIMP_TAC std_ss [EXTENSION, IN_UNIV, NOT_IN_EMPTY, GSPECIFICATION] THEN
          DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC MP_TAC) THENL
           [EXISTS_TAC ``b:real`` THEN ASM_REWRITE_TAC[] THEN
            SIMP_TAC std_ss [INTEGRAL_NULL, CONTENT_EQ_0, REAL_LE_REFL] THEN
            ASM_SIMP_TAC std_ss [ENDS_IN_INTERVAL, INTEGRAL_0],
            ALL_TAC] THEN
          DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC MP_TAC) THENL
           [EXISTS_TAC ``a:real`` THEN
            ASM_SIMP_TAC std_ss [ETA_AX, ENDS_IN_INTERVAL],
            ALL_TAC] THEN
          SIMP_TAC std_ss [METIS [OR_EXISTS_THM]
           ``(?(a :real). (!(x :real). (y :real) <= (g :real -> real) x <=> a <= x)) \/
             (?(a :real). !(x :real). y <= g x <=> a < x) <=>
              ?a. ((\a. !x. y <= (g:real->real) x <=> a <= x) a \/
                   (\a. !x. y <= (g:real->real) x <=> a < x) a)``] THEN
          DISCH_THEN(X_CHOOSE_THEN ``d:real`` ASSUME_TAC) THEN
          ASM_CASES_TAC ``d < a:real`` THENL
           [EXISTS_TAC ``a:real`` THEN
            ASM_SIMP_TAC std_ss [ETA_AX, ENDS_IN_INTERVAL] THEN
            MATCH_MP_TAC INTEGRAL_EQ THEN
            SIMP_TAC std_ss [IN_DIFF, IN_INTERVAL, NOT_IN_EMPTY] THEN
            GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
            UNDISCH_TAC ``~(y <= (g:real->real) x)`` THEN
            FIRST_X_ASSUM DISJ_CASES_TAC THEN ASM_SIMP_TAC real_ss [] THEN
            UNDISCH_TAC ``d < a:real`` THEN REAL_ARITH_TAC,
            ALL_TAC] THEN
          ASM_CASES_TAC ``b < d:real`` THENL
           [EXISTS_TAC ``b:real`` THEN
            SIMP_TAC std_ss [INTEGRAL_NULL, CONTENT_EQ_0, REAL_LE_REFL] THEN
            ASM_SIMP_TAC std_ss [ENDS_IN_INTERVAL, INTEGRAL_0] THEN
            MATCH_MP_TAC INTEGRAL_EQ_0 THEN SIMP_TAC std_ss [IN_INTERVAL] THEN
            REPEAT STRIP_TAC THEN
            COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [] THEN
            UNDISCH_TAC ``y <= (g:real->real) x`` THEN
            FIRST_X_ASSUM DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
            UNDISCH_TAC ``b < d:real`` THEN UNDISCH_TAC ``x <= b:real`` THEN
            REAL_ARITH_TAC,
            ALL_TAC] THEN
          EXISTS_TAC ``d:real`` THEN
          ASM_REWRITE_TAC[IN_INTERVAL, GSYM REAL_NOT_LT] THEN
          ONCE_REWRITE_TAC[SET_RULE
            ``~((g:real->real) x < y) <=> x IN {x | ~(g x < y)}``] THEN
          SIMP_TAC std_ss [INTEGRAL_RESTRICT_INTER] THEN
          MATCH_MP_TAC INTEGRAL_SPIKE_SET THEN
          MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC ``{d:real}`` THEN
          REWRITE_TAC[NEGLIGIBLE_SING, REAL_NOT_LT, SUBSET_DEF] THEN GEN_TAC THEN
          SIMP_TAC std_ss [SUBSET_DEF, IN_UNION, IN_INTER, IN_DIFF, IN_INTERVAL,
                      GSPECIFICATION, IN_SING] THEN
          FIRST_X_ASSUM DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
          UNDISCH_TAC ``~(d < a:real)`` THEN UNDISCH_TAC ``~(b < d:real)`` THEN
          REAL_ARITH_TAC ],
        (* goal 1.2 (of 2) *)
        DISCH_THEN(MP_TAC o GEN ``k:num`` o SPEC ``&k / &n:real``) THEN
        SIMP_TAC std_ss [SKOLEM_THM, FORALL_AND_THM, LEFT_IMP_EXISTS_THM] THEN
        X_GEN_TAC ``d:num->real`` THEN STRIP_TAC THEN
        FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE
         ``(IMAGE f s = t) ==> !y. y IN t ==> ?x. x IN s /\ (f x = y)``)) THEN
        SIMP_TAC std_ss [GSYM SUM_LMUL] THEN DISCH_THEN MATCH_MP_TAC THEN
        ONCE_REWRITE_TAC [METIS []
         ``(\k. inv (&n) * integral (interval [(d k,b)]) f) =
           (\k. (\k. inv (&n)) k * (\k. integral (interval [(d k,b)]) f) k)``] THEN
        MATCH_MP_TAC(REWRITE_RULE[CONVEX_INDEXED]
         (CONJUNCT1(SPEC_ALL CONVEX_INTERVAL))) THEN
        SIMP_TAC real_ss [SUM_CONST_NUMSEG, ADD_SUB, REAL_LE_INV_EQ, REAL_POS] THEN
        ASM_SIMP_TAC real_ss [REAL_MUL_RINV, REAL_OF_NUM_EQ] THEN ASM_SET_TAC[] ],
      (* goal 2 (of 2) *)
      SIMP_TAC std_ss [SKOLEM_THM, LEFT_IMP_EXISTS_THM, FORALL_AND_THM] THEN
      X_GEN_TAC ``c:num->real`` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) ] THEN
    (* stage work *)
    SUBGOAL_THEN ``compact(interval[a:real,b])`` MP_TAC THENL
     [REWRITE_TAC[COMPACT_INTERVAL], REWRITE_TAC[compact]] THEN
    DISCH_THEN(MP_TAC o SPEC ``c:num->real``) THEN
    ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC
     [``d:real``, ``s:num->num``] THEN STRIP_TAC THEN
    MP_TAC(ISPECL
     [``\n:num x. sum ((1:num)..(s n))
                      (\k. if &k / &((s:num->num) n):real <= (g:real->real) x
                           then inv(&(s n)) * (f:real->real) x
                           else 0)``,
      ``\x. (g:real->real) x * (f:real->real) x``, ``a:real``, ``b:real``]
     EQUIINTEGRABLE_LIMIT) THEN
    ASM_SIMP_TAC std_ss [] THEN
    KNOW_TAC ``{(\(x :real).
     sum ((1 :num) .. (s :num -> num) n)
       (\(k :num).
          if ((&k) :real) / ((&s n) :real) <= (g :real -> real) x then
            inv ((&s n) :real) * (f :real -> real) x
          else (0 :real))) |
       n IN univ((:num) :num itself)} equiintegrable_on
         interval [((a :real),(b :real))] /\
     (!(x :real). x IN interval [(a,b)] ==>
     (((\(n :num). sum ((1 :num) .. s n)
           (\(k :num).
              if ((&k) :real) / ((&s n) :real) <= g x then
                inv ((&s n) :real) * f x
              else (0 :real))) --> (g x * f x)) sequentially :bool))`` THENL
     [CONJ_TAC THENL
       [MATCH_MP_TAC EQUIINTEGRABLE_SUBSET THEN
        EXISTS_TAC
         ``{\x. sum((1:num)..(0:num)) (\k. if &k / &0:real <= (g:real->real) x
                               then inv(&0) * (f:real->real) x else 0)}
          UNION
          {\x. sum ((1:num)..(n:num))
                    (\k. if &k / &n <= g x then inv (&n) * f x else 0)
           | ~(n = 0)}`` THEN
        CONJ_TAC THENL
         [MATCH_MP_TAC EQUIINTEGRABLE_UNION THEN ASM_REWRITE_TAC[] THEN
          SIMP_TAC arith_ss [EQUIINTEGRABLE_ON_SING, SUM_CLAUSES_NUMSEG] THEN
          SIMP_TAC std_ss [INTEGRABLE_0],
          SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_GSPEC, IN_UNIV, IN_UNION] THEN
          SIMP_TAC std_ss [GSPECIFICATION, IN_SING] THEN
          X_GEN_TAC ``n:num`` THEN ASM_CASES_TAC ``(s:num->num) n = 0`` THEN
          ASM_REWRITE_TAC[] THEN DISJ2_TAC THEN
          EXISTS_TAC ``(s:num->num) n`` THEN ASM_REWRITE_TAC[]],
        X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN SIMP_TAC std_ss [] THEN
        ONCE_REWRITE_TAC[METIS [REAL_MUL_LZERO]
         ``(if p then a * x else 0:real) = (if p then a else &0) * x``] THEN
        SIMP_TAC std_ss [SUM_RMUL] THEN
        ONCE_REWRITE_TAC [METIS []
         ``(\n. sum (1 .. s n)
            (\k. if &k / &s n <= (g:real->real) x then inv (&s n) else 0) * f x) =
           (\n. (\n. sum (1 .. s n)
            (\k. if &k / &s n <= g x then inv (&s n) else 0)) n * (\n. f x) n)``] THEN
        MATCH_MP_TAC LIM_MUL THEN
        SIMP_TAC std_ss [LIM_SEQUENTIALLY, o_DEF, DIST_REFL] THEN
        X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
        MP_TAC(ISPEC ``e:real`` REAL_ARCH_INV) THEN
        ASM_REWRITE_TAC[] THEN DISCH_THEN (X_CHOOSE_TAC ``N:num``) THEN
        EXISTS_TAC ``N:num`` THEN POP_ASSUM MP_TAC THEN
        STRIP_TAC THEN X_GEN_TAC ``n:num`` THEN DISCH_TAC THEN
        REWRITE_TAC [dist] THEN ONCE_REWRITE_TAC[ABS_SUB] THEN
        MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC ``inv(&n:real)`` THEN
        CONJ_TAC THENL
         [MP_TAC(ISPECL
           [``(g:real->real)``, ``IMAGE (\x. x) (interval[a,b])``]
            lemma1) THEN
          ASM_SIMP_TAC std_ss [FORALL_IN_IMAGE, o_DEF, IMP_CONJ,
                          RIGHT_FORALL_IMP_THM] THEN
          REWRITE_TAC[AND_IMP_INTRO] THEN DISCH_TAC THEN
          MATCH_MP_TAC REAL_LTE_TRANS THEN
          EXISTS_TAC ``inv(&((s:num->num) n):real)`` THEN CONJ_TAC THENL
           [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC std_ss [],
            MATCH_MP_TAC REAL_LE_INV2 THEN
            REWRITE_TAC[REAL_OF_NUM_LE, REAL_LT]] THEN
          FIRST_ASSUM(MP_TAC o SPEC ``n:num`` o MATCH_MP MONOTONE_BIGGER) THEN
          ASM_SIMP_TAC arith_ss [],
          MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ``inv(&N:real)`` THEN
          ASM_SIMP_TAC std_ss [] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
          REWRITE_TAC[REAL_OF_NUM_LE, REAL_LT] THEN ASM_SIMP_TAC arith_ss []]],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      EXISTS_TAC ``d:real`` THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC(ISPEC ``sequentially`` LIM_UNIQUE) THEN
      EXISTS_TAC ``\n. integral (interval [c((s:num->num) n),b])
                               (f:real->real)`` THEN
      ASM_SIMP_TAC std_ss [TRIVIAL_LIMIT_SEQUENTIALLY] THEN
      MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``b:real``]
          INDEFINITE_INTEGRAL_CONTINUOUS_LEFT) THEN
      ASM_REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
      DISCH_THEN(MP_TAC o SPEC ``d:real``) THEN ASM_REWRITE_TAC[] THEN
      REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY] THEN
      DISCH_THEN(MP_TAC o SPEC ``(c:num->real) o (s:num->num)``) THEN
      ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC std_ss [o_DEF]]);

val SECOND_MEAN_VALUE_THEOREM_FULL = store_thm ("SECOND_MEAN_VALUE_THEOREM_FULL",
 ``!f:real->real g a b.
        ~(interval[a,b] = {}) /\
        f integrable_on interval [a,b] /\
        (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
               ==> g x <= g y)
        ==> ?c. c IN interval [a,b] /\
                ((\x. g x * f x) has_integral
                 (g(a) * integral (interval[a,c]) f +
                  g(b) * integral (interval[c,b]) f)) (interval[a,b])``,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  SUBGOAL_THEN ``(g:real->real) a <= g b`` MP_TAC THENL
   [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN
    ASM_MESON_TAC[GSYM INTERVAL_EQ_EMPTY, REAL_LET_TOTAL],
    ALL_TAC] THEN
  REWRITE_TAC[REAL_LE_LT] THEN STRIP_TAC THENL
   [ALL_TAC,
    SUBGOAL_THEN
     ``!x. x IN interval[a,b] ==> ((g:real->real)(x) * (f:real->real)(x) = g(a) * f x)``
    ASSUME_TAC THENL
     [X_GEN_TAC ``x:real`` THEN
      REWRITE_TAC[IN_INTERVAL] THEN STRIP_TAC THEN
      AP_THM_TAC THEN AP_TERM_TAC THEN
      RULE_ASSUM_TAC(REWRITE_RULE
       [IN_INTERVAL, GSYM INTERVAL_EQ_EMPTY, REAL_NOT_LT]) THEN
      ASM_MESON_TAC[REAL_LE_ANTISYM, REAL_LE_TRANS, REAL_LE_TOTAL],
      ALL_TAC] THEN
    EXISTS_TAC ``a:real`` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN
    MATCH_MP_TAC HAS_INTEGRAL_EQ THEN
    EXISTS_TAC ``\x. g(a:real) * (f:real->real) x`` THEN
    ASM_SIMP_TAC std_ss [INTEGRAL_NULL, CONTENT_EQ_0, REAL_LE_REFL] THEN
    ASM_SIMP_TAC std_ss [INTEGRAL_CMUL, REAL_MUL_RZERO, REAL_ADD_LID] THEN
    MATCH_MP_TAC HAS_INTEGRAL_CMUL THEN
    ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]] THEN
  MP_TAC(ISPECL
   [``f:real->real``,
    ``(\x. if x < a then &0
         else if b < x then &1
         else (g(x) - g(a)) / (g(b) - (g:real->real)(a)))``,
    ``a:real``, ``b:real``]
   lemma4) THEN ASM_SIMP_TAC std_ss [] THEN
  KNOW_TAC ``(!(x :real) (y :real).
    x <= y ==>
    (if x < (a :real) then (0 :real)
     else if (b :real) < x then (1 :real)
     else ((g :real -> real) x - g a) / (g b - g a)) <=
    if y < a then (0 :real)
    else if b < y then (1 :real)
    else (g y - g a) / (g b - g a)) /\
 (!(x :real).
    x IN interval [(a,b)] ==>
    (0 :real) <=
    (if x < a then (0 :real)
     else if b < x then (1 :real)
     else (g x - g a) / (g b - g a)) /\
    (if x < a then (0 :real)
     else if b < x then (1 :real)
     else (g x - g a) / (g b - g a)) <= (1 :real))`` THENL
   [CONJ_TAC THEN
    REPEAT GEN_TAC THEN
    REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_POS, REAL_LE_REFL]) THEN
    TRY ASM_REAL_ARITH_TAC THEN
    ASM_SIMP_TAC real_ss [IN_INTERVAL, REAL_SUB_LT] THEN
    ASM_SIMP_TAC real_ss [REAL_LE_LDIV_EQ, REAL_LE_RDIV_EQ, REAL_SUB_LT] THEN
    ASM_REWRITE_TAC[REAL_MUL_LZERO, REAL_MUL_LID, REAL_SUB_LE,
                    REAL_ARITH ``x - a <= y - a <=> x <= y:real``] THEN
    REPEAT STRIP_TAC THEN TRY (FIRST_X_ASSUM MATCH_MP_TAC) THEN
    REWRITE_TAC[IN_INTERVAL] THEN TRY (ASM_REAL_ARITH_TAC) THENL
    [POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC,
     REWRITE_TAC [REAL_ARITH ``a - b <= 0 <=> a <= b:real``] THEN
     FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN
     ASM_REAL_ARITH_TAC,
     UNDISCH_TAC ``g a < (g:real->real) b`` THEN
     GEN_REWR_TAC LAND_CONV [REAL_ARITH ``a < b <=> 0 < b - a:real``] THEN
     DISCH_THEN (MP_TAC o ONCE_REWRITE_RULE [EQ_SYM_EQ] o MATCH_MP REAL_LT_IMP_NE) THEN
     DISCH_TAC THEN REWRITE_TAC [real_div, GSYM REAL_MUL_ASSOC] THEN
     ASM_SIMP_TAC real_ss [REAL_MUL_LINV] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
     REWRITE_TAC[IN_INTERVAL] THEN ASM_REAL_ARITH_TAC],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  SIMP_TAC std_ss [GSYM RIGHT_EXISTS_AND_THM] THEN
  DISCH_THEN (X_CHOOSE_TAC ``c:real``) THEN EXISTS_TAC ``c:real`` THEN
  POP_ASSUM MP_TAC THEN
  ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> b ==> a /\ c ==> d`] THEN
  DISCH_TAC THEN ASM_SIMP_TAC std_ss [GSYM HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN
  DISCH_THEN(MP_TAC o SPEC ``(g:real->real) b - g a`` o
        MATCH_MP HAS_INTEGRAL_CMUL) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN
  DISCH_THEN(MP_TAC o SPEC ``(g:real->real)(a)`` o
      MATCH_MP HAS_INTEGRAL_CMUL) THEN REWRITE_TAC[AND_IMP_INTRO] THEN
  DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_ADD) THEN
  MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``b:real``, ``c:real``]
        INTEGRAL_COMBINE) THEN
  KNOW_TAC ``a <= c /\ c <= b:real /\ f integrable_on interval [(a,b)]`` THENL
   [ASM_MESON_TAC[IN_INTERVAL],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  DISCH_THEN(SUBST1_TAC o SYM) THEN
  SIMP_TAC std_ss [REAL_ARITH
   ``ga * (i1 + i2) + (gb - ga) * i2:real = ga * i1 + gb * i2:real``] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_EQ) THEN
  X_GEN_TAC ``x:real`` THEN REWRITE_TAC[IN_INTERVAL] THEN STRIP_TAC THEN
  ASM_SIMP_TAC std_ss [GSYM REAL_NOT_LE, REAL_MUL_ASSOC] THEN
  ASM_SIMP_TAC real_ss [REAL_DIV_LMUL, REAL_LT_IMP_NE, REAL_SUB_LT]);

val SECOND_MEAN_VALUE_THEOREM = store_thm ("SECOND_MEAN_VALUE_THEOREM",
 ``!f:real->real g a b.
        ~(interval[a,b] = {}) /\
        f integrable_on interval [a,b] /\
        (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
               ==> g x <= g y)
        ==> ?c. c IN interval [a,b] /\
                (integral (interval[a,b]) (\x. g x * f x) =
                 g(a) * integral (interval[a,c]) f +
                 g(b) * integral (interval[c,b]) f)``,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP SECOND_MEAN_VALUE_THEOREM_FULL) THEN
  DISCH_THEN (X_CHOOSE_TAC ``c:real``) THEN EXISTS_TAC ``c:real`` THEN
  POP_ASSUM MP_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REWRITE_TAC[]);

val SECOND_MEAN_VALUE_THEOREM_GEN_FULL = store_thm ("SECOND_MEAN_VALUE_THEOREM_GEN_FULL",
 ``!f:real->real g a b u v.
        ~(interval[a,b] = {}) /\ f integrable_on interval [a,b] /\
        (!x. x IN interval(a,b) ==> u <= g x /\ g x <= v) /\
        (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
               ==> g x <= g y)
        ==> ?c. c IN interval [a,b] /\
                ((\x. g x * f x) has_integral
                 (u * integral (interval[a,c]) f +
                  v * integral (interval[c,b]) f)) (interval[a,b])``,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC ``b:real = a`` THENL
   [EXISTS_TAC ``a:real`` THEN ASM_REWRITE_TAC[INTERVAL_SING, IN_SING] THEN
    ASM_SIMP_TAC std_ss [GSYM INTERVAL_SING, INTEGRAL_NULL, CONTENT_EQ_0,
      REAL_ADD_LID, REAL_LE_REFL, REAL_MUL_RZERO, HAS_INTEGRAL_NULL],
    ALL_TAC] THEN
  SUBGOAL_THEN ``a < b:real`` ASSUME_TAC THENL
   [METIS_TAC[GSYM INTERVAL_EQ_EMPTY, REAL_NOT_LE, REAL_LT_LE],
    ALL_TAC] THEN
  SUBGOAL_THEN ``u <= v:real`` ASSUME_TAC THENL
   [METIS_TAC[GSYM INTERVAL_EQ_EMPTY, MEMBER_NOT_EMPTY, REAL_NOT_LT,
                  REAL_LE_TRANS],
    ALL_TAC] THEN
  MP_TAC(ISPECL
   [``f:real->real``,
    ``\x:real. if x = a then u else if x = b then v else g x:real``,
    ``a:real``, ``b:real``] SECOND_MEAN_VALUE_THEOREM_FULL) THEN
  ASM_SIMP_TAC std_ss [REAL_MUL_LZERO, REAL_ADD_LID] THEN
  KNOW_TAC ``(!x y.
    x IN interval [(a,b)] /\ y IN interval [(a,b)] /\ x <= y ==>
    (if x = a then u else if x = b then v else (g:real->real) x) <=
    if y = a then u else if y = b then v else g y)`` THENL
   [MAP_EVERY X_GEN_TAC [``x:real``, ``y:real``] THEN
    ASM_CASES_TAC ``x:real = a`` THEN ASM_REWRITE_TAC[] THENL
     [METIS_TAC[REAL_LE_REFL, INTERVAL_CASES], ALL_TAC] THEN
    ASM_CASES_TAC ``y:real = b`` THEN ASM_REWRITE_TAC[] THENL
     [METIS_TAC[REAL_LE_REFL, INTERVAL_CASES], ALL_TAC] THEN
    REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC std_ss []) THEN
    REWRITE_TAC[IN_INTERVAL] THEN POP_ASSUM MP_TAC THEN
    POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
    POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
    POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
    TRY REAL_ARITH_TAC THEN UNDISCH_TAC ``b <= y:real`` THEN
    UNDISCH_TAC ``y <= b:real`` THEN UNDISCH_TAC ``y <> b:real`` THEN
    REAL_ARITH_TAC,
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    DISCH_THEN (X_CHOOSE_TAC ``c:real``) THEN EXISTS_TAC ``c:real`` THEN
    POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_AND THEN
    REWRITE_TAC[] THEN MATCH_MP_TAC
     (REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`]
        HAS_INTEGRAL_SPIKE) THEN
    EXISTS_TAC ``{a:real;b}`` THEN
    SIMP_TAC std_ss [NEGLIGIBLE_EMPTY, NEGLIGIBLE_INSERT, IN_DIFF, IN_INSERT,
             NOT_IN_EMPTY, DE_MORGAN_THM]]);

val SECOND_MEAN_VALUE_THEOREM_GEN = store_thm ("SECOND_MEAN_VALUE_THEOREM_GEN",
 ``!f:real->real g a b u v.
        ~(interval[a,b] = {}) /\ f integrable_on interval [a,b] /\
        (!x. x IN interval(a,b) ==> u <= g x /\ g x <= v) /\
        (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
               ==> g x <= g y)
        ==> ?c. c IN interval [a,b] /\
               (integral (interval[a,b]) (\x. g x * f x) =
                u * integral (interval[a,c]) f +
                v * integral (interval[c,b]) f)``,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP SECOND_MEAN_VALUE_THEOREM_GEN_FULL) THEN
  DISCH_THEN (X_CHOOSE_TAC ``c:real``) THEN EXISTS_TAC ``c:real`` THEN
    POP_ASSUM MP_TAC THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC std_ss [] THEN
  FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REWRITE_TAC[]);

val SECOND_MEAN_VALUE_THEOREM_BONNET_FULL = store_thm ("SECOND_MEAN_VALUE_THEOREM_BONNET_FULL",
 ``!f:real->real g a b.
        ~(interval[a,b] = {}) /\ f integrable_on interval [a,b] /\
        (!x. x IN interval[a,b] ==> &0 <= g x) /\
        (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
               ==> g x <= g y)
        ==> ?c. c IN interval [a,b] /\
                ((\x. g x * f x) has_integral
                 (g(b) * integral (interval[c,b]) f)) (interval[a,b])``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL
   [``f:real->real``, ``g:real->real``, ``a:real``, ``b:real``,
    ``&0:real``, ``(g:real->real) b``] SECOND_MEAN_VALUE_THEOREM_GEN_FULL) THEN
  ASM_REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_LID] THEN
  DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_SIMP_TAC real_ss [IN_INTERVAL, REAL_LE_LT] THEN METIS_TAC [REAL_LT_TRANS]);

val SECOND_MEAN_VALUE_THEOREM_BONNET = store_thm ("SECOND_MEAN_VALUE_THEOREM_BONNET",
 ``!f:real->real g a b.
        ~(interval[a,b] = {}) /\ f integrable_on interval[a,b] /\
        (!x. x IN interval[a,b] ==> &0 <= g x) /\
        (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
               ==> g x <= g y)
        ==> ?c. c IN interval [a,b] /\
               (integral (interval[a,b]) (\x. g x * f x) =
                g(b) * integral (interval[c,b]) f)``,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP SECOND_MEAN_VALUE_THEOREM_BONNET_FULL) THEN
  DISCH_THEN (X_CHOOSE_TAC ``c:real``) THEN EXISTS_TAC ``c:real`` THEN
    POP_ASSUM MP_TAC THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC std_ss [] THEN
  FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REWRITE_TAC[]);

val INTEGRABLE_INCREASING_PRODUCT = store_thm ("INTEGRABLE_INCREASING_PRODUCT",
 ``!f:real->real g a b.
        f integrable_on interval[a,b] /\
        (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
               ==> g(x) <= g(y))
        ==> (\x. g(x) * f(x)) integrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC ``interval[a:real,b] = {}`` THEN
  ASM_REWRITE_TAC[INTEGRABLE_ON_EMPTY] THEN
  MP_TAC(ISPECL [``\x. ((f:real->real) x)``,
                 ``g:real->real``, ``a:real``, ``b:real``]
    SECOND_MEAN_VALUE_THEOREM_FULL) THEN ASM_REWRITE_TAC[] THEN
  KNOW_TAC ``(\x. (f:real->real) x) integrable_on interval [(a,b)]`` THENL
   [RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTEGRABLE_COMPONENTWISE]) THEN
    ASM_SIMP_TAC std_ss [],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    REWRITE_TAC[integrable_on] THEN MESON_TAC[]]);

val lemma = prove (
   ``!f:real->real g B.
          f integrable_on univ(:real) /\
          (!x y. x <= y ==> g x <= g y) /\
          (!x. abs(g x) <= B)
           ==> (\x. g x * f x) integrable_on univ(:real)``,
    REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[INTEGRABLE_ALT_SUBSET] THEN
    SIMP_TAC std_ss [IN_UNIV, ETA_AX] THEN STRIP_TAC THEN
    MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
     [REPEAT GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_INCREASING_PRODUCT THEN
      ASM_SIMP_TAC std_ss [],
      DISCH_TAC] THEN
    X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
    UNDISCH_TAC ``!e. 0 < e ==>
        ?B. 0 < B /\
          !a b c d.
            ball (0,B) SUBSET interval [(a,b)] /\
            interval [(a,b)] SUBSET interval [(c,d)] ==>
            abs (integral (interval [(a,b)]) f -
                 integral (interval [(c,d)]) f) < e`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``e / (&8 * abs B + &8:real)``) THEN
    ASM_SIMP_TAC real_ss [REAL_LT_DIV, REAL_ARITH ``&0 < &8 * abs B + &8:real``] THEN
    DISCH_THEN (X_CHOOSE_TAC ``C:real``) THEN EXISTS_TAC ``C:real`` THEN
    POP_ASSUM MP_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    SUBGOAL_THEN ``~(ball(0:real,C) = {})`` ASSUME_TAC THENL
     [ASM_REWRITE_TAC[BALL_EQ_EMPTY, REAL_NOT_LE], ALL_TAC] THEN
    MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``, ``c:real``, ``d:real``] THEN
    STRIP_TAC THEN SUBGOAL_THEN
     ``~(interval[a:real,b] = {}) /\ ~(interval[c:real,d] = {})``
    MP_TAC THENL [ASM_SET_TAC[], ALL_TAC] THEN
    SIMP_TAC std_ss [GSYM INTERVAL_EQ_EMPTY, REAL_NOT_LT] THEN STRIP_TAC THEN
    UNDISCH_TAC ``interval [(a,b)] SUBSET interval [(c,d)]`` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o REWRITE_RULE [SUBSET_INTERVAL]) THEN
    ASM_REWRITE_TAC[GSYM REAL_NOT_LE] THEN STRIP_TAC THEN
    MP_TAC(ISPECL [``\x. (g:real->real) x * (f:real->real) x``,
                   ``c:real``, ``b:real``, ``a:real``] INTEGRAL_COMBINE) THEN
    MP_TAC(ISPECL [``\x. (g:real->real) x * (f:real->real) x``,
                   ``c:real``, ``d:real``, ``b:real``] INTEGRAL_COMBINE) THEN
    ASM_REWRITE_TAC[] THEN
    KNOW_TAC ``c <= b:real`` THENL
     [POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
      POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
      POP_ASSUM MP_TAC THEN REAL_ARITH_TAC,
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
      DISCH_THEN(SUBST1_TAC o SYM)] THEN
    DISCH_THEN(SUBST1_TAC o SYM) THEN
    REWRITE_TAC[REAL_NOT_LE, REAL_ARITH
     ``abs(ab - ((ca + ab) + bd):real) = abs(ca + bd)``] THEN
    MP_TAC(ISPECL[``f:real->real``, ``g:real->real``, ``c:real``, ``a:real``]
          SECOND_MEAN_VALUE_THEOREM) THEN
    ASM_SIMP_TAC std_ss [GSYM INTERVAL_EQ_EMPTY, REAL_NOT_LT] THEN
    DISCH_THEN(X_CHOOSE_THEN ``u:real`` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPECL[``f:real->real``, ``g:real->real``, ``b:real``, ``d:real``]
          SECOND_MEAN_VALUE_THEOREM) THEN
    ASM_SIMP_TAC std_ss [GSYM INTERVAL_EQ_EMPTY, REAL_NOT_LT] THEN
    DISCH_THEN(X_CHOOSE_THEN ``v:real`` STRIP_ASSUME_TAC) THEN
    ASM_REWRITE_TAC[] THEN
    SUBGOAL_THEN
     ``!x y. y <= a
            ==> abs(integral (interval[x,y]) (f:real->real))
                < e / (&4 * abs B + &4)``
     ASSUME_TAC
    THENL
     [REPEAT STRIP_TAC THEN
      ASM_CASES_TAC ``x <= y:real`` THENL
       [FIRST_X_ASSUM(fn th =>
         MP_TAC(SPECL[``a:real``, ``b:real``, ``y:real``, ``b:real``] th) THEN
         MP_TAC(SPECL[``a:real``, ``b:real``, ``x:real``, ``b:real``] th)) THEN
        ASM_SIMP_TAC std_ss [SUBSET_INTERVAL, REAL_LE_REFL] THEN
        KNOW_TAC ``x <= a:real`` THENL [METIS_TAC [REAL_LE_TRANS],
         DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
        MP_TAC(ISPECL [``f:real->real``, ``x:real``, ``b:real``, ``y:real``]
          INTEGRAL_COMBINE) THEN
        ASM_REWRITE_TAC[] THEN KNOW_TAC ``y <= b:real`` THENL
         [METIS_TAC [REAL_LE_TRANS], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
          POP_ASSUM K_TAC THEN DISCH_THEN(SUBST1_TAC o SYM)] THEN
        MATCH_MP_TAC(REAL_ARITH
         ``(&2 * d = e:real)
          ==> abs(ab - (xy + yb)) < d
              ==> abs(ab - yb) < d
                  ==> abs(xy:real) < e``) THEN
        REWRITE_TAC [real_div, REAL_MUL_ASSOC] THEN
        REWRITE_TAC [REAL_ARITH ``inv (8 * abs B + 8) = inv (8 * (abs B + 1:real))``] THEN
        REWRITE_TAC [REAL_ARITH ``inv (4 * abs B + 4) = inv (4 * (abs B + 1:real))``] THEN
        KNOW_TAC ``abs B + 1 <> 0:real`` THENL
        [ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN
         REAL_ARITH_TAC, DISCH_TAC] THEN REWRITE_TAC [REAL_ARITH ``8 = 2 * 4:real``] THEN
        ASM_SIMP_TAC real_ss [REAL_INV_MUL] THEN REWRITE_TAC [REAL_MUL_ASSOC] THEN
        ONCE_REWRITE_TAC [REAL_ARITH ``2 * a * inv 2 * b * c = 2 * inv 2 * a * b * c:real``] THEN
        SIMP_TAC real_ss [REAL_MUL_RINV],
        SUBGOAL_THEN ``interval[x:real,y] = {}`` SUBST1_TAC THENL
         [REWRITE_TAC[GSYM INTERVAL_EQ_EMPTY] THEN FULL_SIMP_TAC std_ss [REAL_NOT_LE],
          REWRITE_TAC[INTEGRAL_EMPTY, ABS_0] THEN
          MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC [] THEN REAL_ARITH_TAC]],
      ALL_TAC] THEN
    SUBGOAL_THEN
     ``!x y. b <= x
            ==> abs(integral (interval[x,y]) (f:real->real))
                < e / (&4 * abs B + &4)``
     ASSUME_TAC
    THENL
     [REPEAT STRIP_TAC THEN
      ASM_CASES_TAC ``x <= y:real`` THENL
       [FIRST_X_ASSUM(fn th =>
         MP_TAC(SPECL[``a:real``, ``b:real``, ``a:real``, ``x:real``] th) THEN
         MP_TAC(SPECL[``a:real``, ``b:real``, ``a:real``, ``y:real``] th)) THEN
        ASM_SIMP_TAC std_ss [SUBSET_INTERVAL, REAL_LE_REFL] THEN
        KNOW_TAC ``b <= y:real`` THENL [METIS_TAC [REAL_LE_TRANS],
         DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
        MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``y:real``, ``x:real``]
          INTEGRAL_COMBINE) THEN
        ASM_REWRITE_TAC[] THEN KNOW_TAC ``a <= x:real`` THENL
         [METIS_TAC [REAL_LE_TRANS], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
          POP_ASSUM K_TAC THEN DISCH_THEN(SUBST1_TAC o SYM)] THEN
        MATCH_MP_TAC(REAL_ARITH
         ``(&2 * d = e:real)
          ==> abs(ab - (ax + xy)) < d
              ==> abs(ab - ax) < d
                  ==> abs(xy:real) < e``) THEN
        REWRITE_TAC [real_div, REAL_MUL_ASSOC] THEN
        REWRITE_TAC [REAL_ARITH
        ``inv (8 * abs B + 8) = inv (8 * (abs B + 1:real))``] THEN
        REWRITE_TAC [REAL_ARITH
        ``inv (4 * abs B + 4) = inv (4 * (abs B + 1:real))``] THEN
        KNOW_TAC ``abs B + 1 <> 0:real`` THENL
        [ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN
         REAL_ARITH_TAC, DISCH_TAC] THEN REWRITE_TAC [REAL_ARITH ``8 = 2 * 4:real``] THEN
        ASM_SIMP_TAC real_ss [REAL_INV_MUL] THEN REWRITE_TAC [REAL_MUL_ASSOC] THEN
        ONCE_REWRITE_TAC [REAL_ARITH
        ``2 * a * inv 2 * b * c = 2 * inv 2 * a * b * c:real``] THEN
        SIMP_TAC real_ss [REAL_MUL_RINV],
        SUBGOAL_THEN ``interval[x:real,y] = {}`` SUBST1_TAC THENL
         [REWRITE_TAC[GSYM INTERVAL_EQ_EMPTY] THEN FULL_SIMP_TAC std_ss [REAL_NOT_LE],
          REWRITE_TAC[INTEGRAL_EMPTY, ABS_0] THEN
          MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC [] THEN REAL_ARITH_TAC]],
      ALL_TAC] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
    MATCH_MP_TAC REAL_LET_TRANS THEN
    EXISTS_TAC ``&4 * B * e / (&4 * abs B + &4:real)`` THEN CONJ_TAC THENL
     [REWRITE_TAC [real_div, GSYM REAL_MUL_ASSOC] THEN
      MATCH_MP_TAC(REAL_ARITH
       ``(abs a <= e /\ abs b <= e) /\ (abs c <= e /\ abs d <= e)
        ==> abs((a + b) + (c + d):real) <= &4 * e:real``) THEN
      REWRITE_TAC[ABS_MUL] THEN CONJ_TAC THENL
       [CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN
        ASM_REWRITE_TAC[ABS_POS] THEN
        MATCH_MP_TAC REAL_LT_IMP_LE THEN
        UNDISCH_TAC ``!x y. y <= a ==>
         abs (integral (interval [(x,y)]) f) < e / (4 * abs B + 4:real)`` THEN
        DISCH_TAC THEN REWRITE_TAC [GSYM real_div] THEN
        FIRST_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC real_ss [],
        CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN
        ASM_REWRITE_TAC[ABS_POS] THEN
        MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC [GSYM real_div] THEN
        FIRST_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC real_ss []],
      REWRITE_TAC [real_div] THEN
      REWRITE_TAC[REAL_ARITH
       ``&4 * B * e * y < e <=> e * ((&4 * B) * y) < e * &1:real``] THEN
      REWRITE_TAC [GSYM real_div] THEN
      ASM_SIMP_TAC real_ss [REAL_LT_LMUL, REAL_LT_LDIV_EQ,
                   REAL_ARITH ``&0 < &4 * abs B + &4:real``] THEN
      REAL_ARITH_TAC]);

val INTEGRABLE_INCREASING_PRODUCT_UNIV = store_thm ("INTEGRABLE_INCREASING_PRODUCT_UNIV",
 ``!f:real->real g B.
        f integrable_on univ(:real) /\
        (!x y. x <= y ==> g x <= g y) /\
        (!x. abs(g x) <= B)
         ==> (\x. g x * f x) integrable_on univ(:real)``,
  REWRITE_TAC [lemma]);

val INTEGRABLE_INCREASING = store_thm ("INTEGRABLE_INCREASING",
 ``!f:real->real a b.
        (!x y i. x IN interval[a,b] /\ y IN interval[a,b] /\
                 x <= y ==> f(x) <= f(y))
        ==> f integrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[METIS [ETA_AX, REAL_MUL_RID]
   ``(f:real->real) = (\x. f x * (\x. 1) x)``] THEN
  MATCH_MP_TAC INTEGRABLE_INCREASING_PRODUCT THEN
  ASM_SIMP_TAC std_ss [INTEGRABLE_CONST]);

val INTEGRABLE_DECREASING_PRODUCT = store_thm ("INTEGRABLE_DECREASING_PRODUCT",
 ``!f:real->real g a b.
        f integrable_on interval[a,b] /\
        (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
               ==> g(y) <= g(x))
        ==> (\x. g(x) * f(x)) integrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[REAL_ARITH ``x * y:real = -(-x * y)``] THEN
  ONCE_REWRITE_TAC [METIS [] ``(\x. -(-g x * f x)) =
             (\x. -(\x. (-(g:real->real) x * f x)) x)``] THEN
  MATCH_MP_TAC INTEGRABLE_NEG THEN
  ONCE_REWRITE_TAC [METIS [] ``(\x. -g x * f x) =
          (\x. (\x. -(g:real->real) x) x * f x)``] THEN
  MATCH_MP_TAC INTEGRABLE_INCREASING_PRODUCT THEN
  ASM_SIMP_TAC real_ss [REAL_LE_NEG2]);

val INTEGRABLE_DECREASING_PRODUCT_UNIV = store_thm ("INTEGRABLE_DECREASING_PRODUCT_UNIV",
 ``!f:real->real g B.
        f integrable_on univ(:real) /\
        (!x y. x <= y ==> g y <= g x) /\
        (!x. abs(g x) <= B)
         ==> (\x. g x * f x) integrable_on univ(:real)``,
  REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[REAL_ARITH ``x * y:real = -(-x * y)``] THEN
  ONCE_REWRITE_TAC [METIS [] ``(\x. -(-g x * f x)) =
             (\x. -(\x. (-(g:real->real) x * f x)) x)``] THEN
  MATCH_MP_TAC INTEGRABLE_NEG THEN
  ONCE_REWRITE_TAC [METIS [] ``(\x. -g x * f x) =
          (\x. (\x. -(g:real->real) x) x * f x)``] THEN
  MATCH_MP_TAC INTEGRABLE_INCREASING_PRODUCT_UNIV THEN
  EXISTS_TAC ``B:real`` THEN ASM_SIMP_TAC real_ss [REAL_LE_NEG2, ABS_NEG]);

val INTEGRABLE_DECREASING = store_thm ("INTEGRABLE_DECREASING",
 ``!f:real->real a b.
        (!x y i. x IN interval[a,b] /\ y IN interval[a,b] /\
                 x <= y ==> f(y) <= f(x))
        ==> f integrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN GEN_REWR_TAC LAND_CONV [GSYM ETA_AX] THEN
  GEN_REWR_TAC (LAND_CONV o BINDER_CONV) [GSYM REAL_NEG_NEG] THEN
  ONCE_REWRITE_TAC [METIS [] ``(\x. --(f:real->real) x) = (\x. -((\x. -f x) x))``] THEN
  MATCH_MP_TAC INTEGRABLE_NEG THEN MATCH_MP_TAC INTEGRABLE_INCREASING THEN
  ASM_SIMP_TAC std_ss [REAL_LE_NEG2]);

(* ------------------------------------------------------------------------- *)
(* Bounded variation and variation function, for real->real functions.       *)
(* ------------------------------------------------------------------------- *)

val _ = set_fixity "has_bounded_variation_on" (Infix(NONASSOC, 450));

val has_bounded_variation_on = new_definition ("has_bounded_variation_on",
 ``(f:real->real) has_bounded_variation_on s <=>
        (\k. f(interval_upperbound k) - f(interval_lowerbound k))
        has_bounded_setvariation_on s``);

val vector_variation = new_definition ("vector_variation",
 ``vector_variation s (f:real->real) =
   set_variation s (\k. f(interval_upperbound k) - f(interval_lowerbound k))``);

val HAS_BOUNDED_VARIATION_ON_EQ = store_thm ("HAS_BOUNDED_VARIATION_ON_EQ",
 ``!f g:real->real s.
        (!x. x IN s ==> (f x = g x)) /\ f has_bounded_variation_on s
        ==> g has_bounded_variation_on s``,
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  REWRITE_TAC[has_bounded_variation_on] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_SETVARIATION_ON_EQ) THEN
  SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_LOWERBOUND,
           GSYM INTERVAL_NE_EMPTY] THEN
  ASM_MESON_TAC[ENDS_IN_INTERVAL, SUBSET_DEF]);

val VECTOR_VARIATION_EQ = store_thm ("VECTOR_VARIATION_EQ",
 ``!f g:real->real s.
        (!x. x IN s ==> (f x = g x))
        ==> (vector_variation s f = vector_variation s g)``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[vector_variation] THEN
  MATCH_MP_TAC SET_VARIATION_EQ THEN
  SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_LOWERBOUND,
           GSYM INTERVAL_NE_EMPTY] THEN
  ASM_MESON_TAC[ENDS_IN_INTERVAL, SUBSET_DEF]);

val HAS_BOUNDED_VARIATION_ON_COMPONENTWISE = store_thm ("HAS_BOUNDED_VARIATION_ON_COMPONENTWISE",
 ``!f:real->real s.
        f has_bounded_variation_on s <=>
          (\x. f x) has_bounded_variation_on s``,
  REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN
  GEN_REWR_TAC LAND_CONV [HAS_BOUNDED_SETVARIATION_ON_COMPONENTWISE] THEN
  SIMP_TAC std_ss []);

val VARIATION_EQUAL_LEMMA = store_thm ("VARIATION_EQUAL_LEMMA",
 ``!ms ms'.
        (!s. (ms'(ms s) = s) /\ (ms(ms' s) = s)) /\
        (!d t. d division_of t
               ==> (IMAGE (IMAGE ms) d) division_of IMAGE ms t /\
                   (IMAGE (IMAGE ms') d) division_of IMAGE ms' t) /\
        (!a b. ~(interval[a,b] = {})
               ==> (IMAGE ms' (interval [a,b]) = interval[ms' a,ms' b]) \/
                   (IMAGE ms' (interval [a,b]) = interval[ms' b,ms' a]))
   ==> (!f:real->real s.
            (\x. f(ms' x)) has_bounded_variation_on (IMAGE ms s) <=>
            f has_bounded_variation_on s) /\
       (!f:real->real s.
            vector_variation (IMAGE ms s) (\x. f(ms' x)) =
            vector_variation s f)``,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  REWRITE_TAC[has_bounded_variation_on, vector_variation] THEN
  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN X_GEN_TAC ``f:real->real`` THEN
  MP_TAC(ISPECL
   [``\f k. (f:(real->bool)->real) (IMAGE (ms':real->real) k)``,
    ``IMAGE (ms:real->real)``,
    ``IMAGE (ms':real->real)``]
  SETVARIATION_EQUAL_LEMMA) THEN
  KNOW_TAC ``(!(s :real -> bool).
    (IMAGE (ms' :real -> real) (IMAGE (ms :real -> real) s) = s) /\
    (IMAGE ms (IMAGE ms' s) = s)) /\
 (!(f :(real -> bool) -> real) (a :real) (b :real).
    interval [(a,b)] <> ({} :real -> bool) ==>
    ((\(f :(real -> bool) -> real) (k :real -> bool). f (IMAGE ms' k)) f
       (IMAGE ms (interval [(a,b)])) =
     f (interval [(a,b)])) /\
    ?(a' :real) (b' :real).
      interval [(a',b')] <> ({} :real -> bool) /\
      (IMAGE ms' (interval [(a,b)]) = interval [(a',b')])) /\
 (!(t :real -> bool) (u :real -> bool).
    t SUBSET u ==>
    IMAGE ms t SUBSET IMAGE ms u /\ IMAGE ms' t SUBSET IMAGE ms' u) /\
 (!(d :(real -> bool) -> bool) (t :real -> bool).
    d division_of t ==>
    IMAGE (IMAGE ms) d division_of IMAGE ms t /\
    IMAGE (IMAGE ms') d division_of IMAGE ms' t)`` THENL
   [ASM_SIMP_TAC std_ss [GSYM IMAGE_COMPOSE, o_DEF, IMAGE_ID, IMAGE_SUBSET] THEN
    MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [``a:real``, ``b:real``]) THEN
    ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    ASM_MESON_TAC[IMAGE_EQ_EMPTY],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  SIMP_TAC std_ss [] THEN DISCH_TAC THEN
  POP_ASSUM (MP_TAC o SIMP_RULE std_ss [GSYM FORALL_AND_THM]) THEN
  DISCH_THEN(fn th =>
    MP_TAC(SPEC ``\k. (f:real->real) (interval_upperbound k) -
                     f (interval_lowerbound k)`` th)) THEN
  SIMP_TAC std_ss [] THEN DISCH_THEN(fn th => ONCE_REWRITE_TAC[GSYM th]) THEN
  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN X_GEN_TAC ``s:real->bool`` THEN
  REWRITE_TAC[has_bounded_setvariation_on, set_variation] THEN
  CONJ_TAC THENL
   [AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
    AP_TERM_TAC THEN ABS_TAC THEN
    REWRITE_TAC[TAUT `((p ==> q) <=> (p ==> r)) <=> p ==> (q <=> r)`] THEN
    STRIP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC,
    AP_TERM_TAC THEN SIMP_TAC std_ss [] THEN
    ONCE_REWRITE_TAC [METIS [] ``{sum d f |
     ?t. d division_of t /\ t SUBSET IMAGE ms s} =
                                 {(\d. sum d f) d |
     (\d. ?t. d division_of t /\ t SUBSET IMAGE ms s) d}``] THEN
    MATCH_MP_TAC(SET_RULE
     ``(!x. P x ==> (f x = g x)) ==> ({f x | P x} = {g x | P x})``) THEN
    SIMP_TAC std_ss [] THEN GEN_TAC THEN STRIP_TAC] THEN MATCH_MP_TAC SUM_EQ THEN
  SIMP_TAC std_ss [] THENL
  [UNDISCH_TAC ``d division_of t``, UNDISCH_TAC ``x division_of t``] THEN
  DISCH_TAC THEN FIRST_ASSUM(fn th =>
   SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [``a:real``, ``b:real``]) THEN
  ASM_REWRITE_TAC[] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN
  DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
   ``(IMAGE f s = s') ==> ~(s = {}) ==> (IMAGE f s = s') /\ ~(s' = {})``)) THEN
  ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
  ASM_SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_LOWERBOUND] THEN
  REAL_ARITH_TAC);

val HAS_BOUNDED_VARIATION_COMPARISON = store_thm ("HAS_BOUNDED_VARIATION_COMPARISON",
 ``!f:real->real g:real->real s.
        f has_bounded_variation_on s /\
        (!x y. x IN s /\ y IN s /\ x < y
               ==> dist(g x,g y) <= dist(f x,f y))
        ==> g has_bounded_variation_on s``,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  REWRITE_TAC[has_bounded_variation_on] THEN
  MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT]
   HAS_BOUNDED_SETVARIATION_COMPARISON) THEN
  REPEAT STRIP_TAC THEN SIMP_TAC std_ss [GSYM dist] THEN
  SUBGOAL_THEN
   ``!x y. x IN s /\ y IN s
          ==> dist((g:real->real) x,g y)
              <= dist((f:real->real) x,f y)``
  MATCH_MP_TAC THENL
   [KNOW_TAC ``!x y. (\x y:real. x IN s /\ y IN s ==> dist (g x,g y) <= dist (f x,f y)) x y`` THENL
    [ALL_TAC, METIS_TAC []] THEN
    MATCH_MP_TAC REAL_WLOG_LT THEN
    ASM_SIMP_TAC std_ss [DIST_REFL, REAL_LE_REFL] THEN
    MESON_TAC[DIST_SYM],
    ASM_SIMP_TAC std_ss [INTERVAL_LOWERBOUND_NONEMPTY,
                         INTERVAL_UPPERBOUND_NONEMPTY] THEN
    ASM_MESON_TAC[ENDS_IN_INTERVAL, SUBSET_DEF]]);

val HAS_BOUNDED_VARIATION_ON_ABS = store_thm ("HAS_BOUNDED_VARIATION_ON_ABS",
 ``!f:real->real.
        (\x. (f x)) has_bounded_variation_on s
        ==> (\x. (abs(f x))) has_bounded_variation_on s``,
  REPEAT GEN_TAC THEN
  MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT]
    HAS_BOUNDED_VARIATION_COMPARISON) THEN
 SIMP_TAC std_ss [dist] THEN REAL_ARITH_TAC);

val VECTOR_VARIATION_COMPARISON = store_thm ("VECTOR_VARIATION_COMPARISON",
 ``!f:real->real g:real->real s.
        f has_bounded_variation_on s /\
        (!x y. x IN s /\ y IN s /\ x < y
               ==> dist(g x,g y) <= dist(f x,f y))
        ==> vector_variation s g <= vector_variation s f``,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[vector_variation] THEN
  MATCH_MP_TAC SET_VARIATION_COMPARISON THEN
  ASM_REWRITE_TAC[GSYM has_bounded_variation_on] THEN
  REPEAT STRIP_TAC THEN SIMP_TAC std_ss [GSYM dist] THEN
  SUBGOAL_THEN
   ``!x y. x IN s /\ y IN s
          ==> dist((g:real->real) x,g y)
              <= dist((f:real->real) x,f y)``
  MATCH_MP_TAC THENL
   [KNOW_TAC ``!x y. (\x y:real. x IN s /\ y IN s ==> dist (g x,g y) <= dist (f x,f y)) x y`` THENL
    [ALL_TAC, METIS_TAC []] THEN
    MATCH_MP_TAC REAL_WLOG_LT THEN
    ASM_SIMP_TAC std_ss [DIST_REFL, REAL_LE_REFL] THEN
    MESON_TAC[DIST_SYM],
    ASM_SIMP_TAC std_ss [INTERVAL_LOWERBOUND_NONEMPTY,
                         INTERVAL_UPPERBOUND_NONEMPTY] THEN
    ASM_MESON_TAC[ENDS_IN_INTERVAL, SUBSET_DEF]]);

val VECTOR_VARIATION_ABS = store_thm ("VECTOR_VARIATION_ABS",
 ``!f:real->real s.
        (\x. (f x)) has_bounded_variation_on s
        ==> vector_variation s (\x. (abs(f x)))
            <= vector_variation s (\x. (f x))``,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC VECTOR_VARIATION_COMPARISON THEN
  ASM_SIMP_TAC std_ss [dist] THEN REAL_ARITH_TAC);

val HAS_BOUNDED_VARIATION_ON_SUBSET = store_thm ("HAS_BOUNDED_VARIATION_ON_SUBSET",
 ``!f:real->real s t.
        f has_bounded_variation_on s /\ t SUBSET s
        ==> f has_bounded_variation_on t``,
  REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_SUBSET, has_bounded_variation_on]);

val HAS_BOUNDED_VARIATION_ON_CONST = store_thm ("HAS_BOUNDED_VARIATION_ON_CONST",
 ``!s c:real. (\x. c) has_bounded_variation_on s``,
  REWRITE_TAC[has_bounded_variation_on, REAL_SUB_REFL,
              HAS_BOUNDED_SETVARIATION_ON_0]);

val VECTOR_VARIATION_CONST = store_thm ("VECTOR_VARIATION_CONST",
 ``!s c:real. vector_variation s (\x. c) = &0``,
  REWRITE_TAC[vector_variation, REAL_SUB_REFL, SET_VARIATION_0]);

val HAS_BOUNDED_VARIATION_ON_CMUL = store_thm ("HAS_BOUNDED_VARIATION_ON_CMUL",
 ``!f:real->real c s.
        f has_bounded_variation_on s
        ==> (\x. c * f x) has_bounded_variation_on s``,
  REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN
  SIMP_TAC std_ss [GSYM REAL_SUB_LDISTRIB, HAS_BOUNDED_SETVARIATION_ON_CMUL]);

val HAS_BOUNDED_VARIATION_ON_NEG = store_thm ("HAS_BOUNDED_VARIATION_ON_NEG",
 ``!f:real->real s.
        f has_bounded_variation_on s
        ==> (\x. -f x) has_bounded_variation_on s``,
  REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN
  SIMP_TAC std_ss [REAL_ARITH ``-a - -b:real = -(a - b)``,
              HAS_BOUNDED_SETVARIATION_ON_NEG]);

val HAS_BOUNDED_VARIATION_ON_ADD = store_thm ("HAS_BOUNDED_VARIATION_ON_ADD",
 ``!f g:real->real s.
        f has_bounded_variation_on s /\ g has_bounded_variation_on s
        ==> (\x. f x + g x) has_bounded_variation_on s``,
  REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN
  SIMP_TAC std_ss [REAL_ARITH ``(f + g) - (f' + g'):real = (f - f') + (g - g')``,
              HAS_BOUNDED_SETVARIATION_ON_ADD]);

val HAS_BOUNDED_VARIATION_ON_SUB = store_thm ("HAS_BOUNDED_VARIATION_ON_SUB",
 ``!f g:real->real s.
        f has_bounded_variation_on s /\ g has_bounded_variation_on s
        ==> (\x. f x - g x) has_bounded_variation_on s``,
  REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN
  SIMP_TAC std_ss [REAL_ARITH ``(f - g) - (f' - g'):real = (f - f') - (g - g')``,
              HAS_BOUNDED_SETVARIATION_ON_SUB]);

val HAS_BOUNDED_VARIATION_ON_COMPOSE_LINEAR = store_thm ("HAS_BOUNDED_VARIATION_ON_COMPOSE_LINEAR",
 ``!f:real->real g:real->real s.
        f has_bounded_variation_on s /\ linear g
        ==> (g o f) has_bounded_variation_on s``,
  REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN
  SIMP_TAC std_ss [o_THM, GSYM LINEAR_SUB] THEN
  DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_SETVARIATION_ON_COMPOSE_LINEAR) THEN
  SIMP_TAC std_ss [o_DEF]);

val HAS_BOUNDED_VARIATION_ON_NULL = store_thm ("HAS_BOUNDED_VARIATION_ON_NULL",
 ``!f:real->real s.
        (content s = &0) /\ bounded s ==> f has_bounded_variation_on s``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN
  MATCH_MP_TAC HAS_BOUNDED_SETVARIATION_ON_NULL THEN
  ASM_SIMP_TAC std_ss [INTERVAL_BOUNDS_NULL, REAL_SUB_REFL]);

val HAS_BOUNDED_VARIATION_ON_EMPTY = store_thm ("HAS_BOUNDED_VARIATION_ON_EMPTY",
 ``!f:real->real. f has_bounded_variation_on {}``,
  MESON_TAC[CONTENT_EMPTY, BOUNDED_EMPTY, HAS_BOUNDED_VARIATION_ON_NULL]);

val VECTOR_VARIATION_ON_NULL = store_thm ("VECTOR_VARIATION_ON_NULL",
 ``!f s. (content s = &0) /\ bounded s ==> (vector_variation s f = &0)``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[vector_variation] THEN
  MATCH_MP_TAC SET_VARIATION_ON_NULL THEN ASM_REWRITE_TAC[] THEN
  SIMP_TAC std_ss [INTERVAL_BOUNDS_NULL, REAL_SUB_REFL]);

val HAS_BOUNDED_VARIATION_ON_ABS = store_thm ("HAS_BOUNDED_VARIATION_ON_ABS",
 ``!f:real->real s.
        f has_bounded_variation_on s
        ==> (\x. (abs(f x))) has_bounded_variation_on s``,
  REWRITE_TAC[has_bounded_variation_on, has_bounded_setvariation_on] THEN
  REPEAT GEN_TAC THEN DISCH_THEN (X_CHOOSE_TAC ``B:real``) THEN
  EXISTS_TAC ``B:real`` THEN POP_ASSUM MP_TAC THEN
  DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN
  POP_ASSUM (MP_TAC o SPECL [``d:(real->bool)->bool``,``t:real->bool``]) THEN
  DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC std_ss [] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
  MATCH_MP_TAC SUM_LE THEN SIMP_TAC std_ss [] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_FINITE], REAL_ARITH_TAC]);

Theorem HAS_BOUNDED_VARIATION_ON_MAX :
    !f g s. f has_bounded_variation_on s /\ g has_bounded_variation_on s
           ==> (\x. (max ((f x)) ((g x))))
               has_bounded_variation_on s
Proof
  REPEAT STRIP_TAC THEN
  Know `!a b. max a b = inv(&2) * (a + b + abs(a - b:real))`
  >- (rpt GEN_TAC >> KILL_TAC \\
      REWRITE_TAC [max_def] >> ONCE_REWRITE_TAC [REAL_MUL_SYM] \\
      SIMP_TAC real_ss [GSYM real_div, REAL_EQ_RDIV_EQ] \\
      Cases_on `a <= b` >> rw [] >> ASM_REAL_ARITH_TAC) \\
  DISCH_TAC THEN
  FIRST_X_ASSUM (fn th => REWRITE_TAC [th]) THEN
  ONCE_REWRITE_TAC [METIS [] ``(\x. inv 2 * (f x + g x + abs (f x - g x:real))) =
                          (\x. inv 2 * (\x. (f x + g x + abs (f x - g x))) x)``] THEN
  MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_CMUL THEN
  ONCE_REWRITE_TAC [METIS [REAL_ADD_ASSOC] ``(\x. f x + g x + abs (f x - g x:real)) =
                          (\x. f x + (\x. g x + abs (f x - g x)) x)``] THEN
  MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_ADD THEN ASM_REWRITE_TAC[] THEN
   ONCE_REWRITE_TAC [METIS [REAL_ADD_ASSOC] ``(\x. g x + abs (f x - g x:real)) =
                          (\x. g x + (\x. abs (f x - g x)) x)``] THEN
  MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_ADD THEN ASM_REWRITE_TAC[] THEN
  ONCE_REWRITE_TAC [METIS [] ``(\x. abs (f x - g x:real)) =
                          (\x. abs ((\x. (f x - g x)) x))``] THEN
  MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_ABS THEN
  MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUB THEN ASM_REWRITE_TAC[]
QED

Theorem HAS_BOUNDED_VARIATION_ON_MIN :
    !f g s. f has_bounded_variation_on s /\ g has_bounded_variation_on s
           ==> (\x. (min ((f x)) ((g x)))) has_bounded_variation_on s
Proof
  REPEAT STRIP_TAC THEN
  Know `!a b. min a b = inv(&2) * ((a + b) - abs(a - b:real))`
  >- (rpt GEN_TAC >> KILL_TAC \\
      REWRITE_TAC [min_def] >> ONCE_REWRITE_TAC [REAL_MUL_SYM] \\
      SIMP_TAC real_ss [GSYM real_div, REAL_EQ_RDIV_EQ] \\
      Cases_on `a <= b` >> rw [] >> ASM_REAL_ARITH_TAC) \\
  DISCH_TAC THEN
  FIRST_X_ASSUM (fn th => REWRITE_TAC [th]) THEN
  ONCE_REWRITE_TAC [METIS [] ``(\x. inv 2 * (f x + g x - abs (f x - g x:real))) =
                          (\x. inv 2 * (\x. (f x + g x - abs (f x - g x))) x)``] THEN
  MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_CMUL THEN
  ONCE_REWRITE_TAC [METIS [REAL_ADD_ASSOC, real_sub]
   ``(\x. f x + g x - abs (f x - g x:real)) =
     (\x. (\x. f x + g x) x - (\x. abs (f x - g x)) x)``] THEN
  MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUB THEN
  ASM_SIMP_TAC std_ss [HAS_BOUNDED_VARIATION_ON_ADD] THEN
  ONCE_REWRITE_TAC [METIS [] ``(\x. abs (f x - g x:real)) =
                          (\x. abs ((\x. (f x - g x)) x))``] THEN
  MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_ABS THEN
  MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUB THEN ASM_REWRITE_TAC[]
QED

val HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS = store_thm ("HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS",
 ``!f:real->real s.
        f has_bounded_variation_on s
        ==> bounded { f(d) - f(c) | interval[c,d] SUBSET s /\
                                    ~(interval[c,d] = {})}``,
  REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN
  DISCH_THEN(MP_TAC o MATCH_MP
   HAS_BOUNDED_SETVARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
  REWRITE_TAC [SUBSET_DEF] THEN SIMP_TAC std_ss [FORALL_IN_GSPEC] THEN
  MAP_EVERY X_GEN_TAC [``d:real``, ``c:real``] THEN
  FULL_SIMP_TAC std_ss [GSYM INTERVAL_EQ_EMPTY, REAL_NOT_LT] THEN STRIP_TAC THEN
  SIMP_TAC std_ss [GSPECIFICATION, EXISTS_PROD] THEN
  MAP_EVERY EXISTS_TAC [``c:real``, ``d:real``] THEN
  ASM_SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_LOWERBOUND]);

val HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED = store_thm ("HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED",
 ``!f:real->real s.
        f has_bounded_variation_on s /\ is_interval s ==> bounded (IMAGE f s)``,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC ``s:real->bool = {}`` THEN
  ASM_SIMP_TAC std_ss [IMAGE_EMPTY, IMAGE_INSERT, BOUNDED_EMPTY] THEN
  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [GSYM MEMBER_NOT_EMPTY]) THEN
  DISCH_THEN(X_CHOOSE_TAC ``a:real``) THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP
    HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS) THEN
  SIMP_TAC std_ss [bounded_def, FORALL_IN_GSPEC, FORALL_IN_IMAGE] THEN
  ASM_SIMP_TAC std_ss [INTERVAL_SUBSET_IS_INTERVAL, LEFT_IMP_EXISTS_THM,
               TAUT `(p \/ q) /\ ~p <=> ~p /\ q`] THEN
  X_GEN_TAC ``B:real`` THEN DISCH_TAC THEN
  EXISTS_TAC ``B + abs((f:real->real) a)`` THEN
  X_GEN_TAC ``b:real`` THEN DISCH_TAC THEN
  KNOW_TAC ``((!d c. ~(interval [c,d] = {}) \/ ~(interval [d,c] = {})) /\
  (!d c. c IN s /\ d IN s ==> abs ((f:real->real) d - f c) <= B <=>
         d IN s /\ c IN s ==> abs (f c - f d) <= B)
  ==> (!d c. c IN s /\ d IN s ==> abs (f d - f c) <= B))`` THENL
  [METIS_TAC [], ALL_TAC] THEN
  FULL_SIMP_TAC std_ss [INTERVAL_NE_EMPTY, REAL_LE_TOTAL] THEN
  SIMP_TAC std_ss [ABS_SUB, CONJ_SYM] THEN
  DISCH_THEN(MP_TAC o SPECL [``a:real``, ``b:real``]) THEN
  FULL_SIMP_TAC std_ss [] THEN REAL_ARITH_TAC);

val HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL = store_thm ("HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL",
 ``!f:real->real a b.
        f has_bounded_variation_on interval[a,b]
        ==> bounded(IMAGE f (interval[a,b]))``,
  MESON_TAC[HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED, IS_INTERVAL_INTERVAL]);

val HAS_BOUNDED_VARIATION_ON_MUL = store_thm ("HAS_BOUNDED_VARIATION_ON_MUL",
 ``!f g:real->real a b.
        f has_bounded_variation_on interval[a,b] /\
        g has_bounded_variation_on interval[a,b]
        ==> (\x. (f x) * g x) has_bounded_variation_on interval[a,b]``,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  SUBGOAL_THEN
    ``bounded(IMAGE (f:real->real) (interval[a,b])) /\
      bounded(IMAGE (g:real->real) (interval[a,b]))``
  MP_TAC THENL
   [ASM_SIMP_TAC std_ss [HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL],
    SIMP_TAC std_ss [BOUNDED_POS_LT, FORALL_IN_IMAGE]] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_THEN ``B1:real`` STRIP_ASSUME_TAC)
   (X_CHOOSE_THEN ``B2:real`` STRIP_ASSUME_TAC)) THEN
  FIRST_X_ASSUM(CONJUNCTS_THEN MP_TAC) THEN
  REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_INTERVAL,
              has_bounded_variation_on] THEN
  DISCH_THEN(X_CHOOSE_THEN ``C2:real`` ASSUME_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN ``C1:real`` ASSUME_TAC) THEN
  EXISTS_TAC ``B1 * C2 + B2 * C1:real`` THEN
  X_GEN_TAC ``d:(real->bool)->bool`` THEN DISCH_TAC THEN
  FULL_SIMP_TAC std_ss [] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
   ``B1 * sum d (\k. abs((g:real->real)(interval_upperbound k) -
                         g(interval_lowerbound k))) +
     B2 * sum d (\k. abs((f:real->real)(interval_upperbound k) -
                         f(interval_lowerbound k)))`` THEN
  CONJ_TAC THENL
   [ALL_TAC, MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_SIMP_TAC std_ss [REAL_LE_LMUL]] THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
  ASM_SIMP_TAC std_ss [GSYM SUM_LMUL, GSYM SUM_ADD] THEN
  MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC std_ss [] THEN
  UNDISCH_TAC ``d division_of interval [(a,b)]`` THEN DISCH_TAC THEN
  FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
  MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN DISCH_TAC THEN
  ONCE_REWRITE_TAC[REAL_ARITH
   ``f' * g' - f * g:real = f' * (g' - g) + (f' - f) * g``] THEN
  MATCH_MP_TAC(REAL_ARITH
    ``abs x <= a /\ abs y <= b ==> abs(x + y) <= a + b:real``) THEN
  SIMP_TAC std_ss [ABS_MUL] THEN
  SUBGOAL_THEN ``~(interval[u:real,v] = {})`` MP_TAC THENL
   [ASM_MESON_TAC[division_of], ALL_TAC] THEN
  REWRITE_TAC[GSYM INTERVAL_EQ_EMPTY, REAL_NOT_LT] THEN DISCH_TAC THEN
  ASM_SIMP_TAC std_ss [INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND] THEN
  SUBGOAL_THEN ``interval[u:real,v] SUBSET interval[a,b]`` MP_TAC THENL
   [ASM_MESON_TAC[division_of], ALL_TAC] THEN
  ASM_SIMP_TAC std_ss [SUBSET_INTERVAL, GSYM REAL_NOT_LE] THEN
  STRIP_TAC THEN
  GEN_REWR_TAC (RAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN
  CONJ_TAC THEN MATCH_MP_TAC REAL_LE_RMUL_IMP THEN SIMP_TAC std_ss [ABS_POS] THEN
  MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  REWRITE_TAC[IN_INTERVAL] THEN POP_ASSUM MP_TAC THEN
  POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);

val VECTOR_VARIATION_POS_LE = store_thm ("VECTOR_VARIATION_POS_LE",
 ``!f:real->real s.
        f has_bounded_variation_on s ==> &0 <= vector_variation s f``,
  REWRITE_TAC[has_bounded_variation_on, vector_variation] THEN
  SIMP_TAC std_ss [SET_VARIATION_POS_LE]);

val VECTOR_VARIATION_GE_ABS_FUNCTION = store_thm ("VECTOR_VARIATION_GE_ABS_FUNCTION",
 ``!f:real->real s a b.
        f has_bounded_variation_on s /\ segment[a,b] SUBSET s
        ==> abs(f b - f a) <= vector_variation s f``,
  GEN_TAC THEN GEN_TAC THEN
  ONCE_REWRITE_TAC [METIS [] ``(!a b.
  f has_bounded_variation_on s /\ segment [(a,b)] SUBSET s ==>
  abs (f b - f a) <= vector_variation s f) =
             (!a b.
  (\a b. f has_bounded_variation_on s /\ segment [(a,b)] SUBSET s ==>
  abs (f b - f a) <= vector_variation s f) a b)``] THEN
  MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL
   [MESON_TAC[SEGMENT_SYM, ABS_SUB], ALL_TAC] THEN
  SIMP_TAC std_ss [has_bounded_variation_on] THEN
  REPEAT STRIP_TAC THEN MP_TAC(ISPECL
  [``\k. (f:real->real)(interval_upperbound k) - f(interval_lowerbound k)``,
   ``s:real->bool``, ``x:real``, ``y:real``] SET_VARIATION_GE_FUNCTION) THEN
  ASM_SIMP_TAC std_ss [vector_variation, INTERVAL_NE_EMPTY] THEN
  ASM_SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_LOWERBOUND] THEN
  METIS_TAC[SEGMENT]);

val VECTOR_VARIATION_GE_FUNCTION = store_thm ("VECTOR_VARIATION_GE_FUNCTION",
 ``!f s a b.
        f has_bounded_variation_on s /\ segment[a,b] SUBSET s
        ==> (f b) - (f a) <= vector_variation s f``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC ``abs((f:real->real) b - f a)`` THEN
  ASM_SIMP_TAC std_ss [VECTOR_VARIATION_GE_ABS_FUNCTION] THEN
  SIMP_TAC std_ss [] THEN REAL_ARITH_TAC);

val CONVEX_CONTAINS_SEGMENT = store_thm ("CONVEX_CONTAINS_SEGMENT",
 ``!s. convex s <=> !a b. a IN s /\ b IN s ==> segment[a,b] SUBSET s``,
  SIMP_TAC std_ss [CONVEX_ALT, segment, SUBSET_DEF, GSPECIFICATION] THEN
  MESON_TAC[]);

val VECTOR_VARIATION_CONST_EQ = store_thm ("VECTOR_VARIATION_CONST_EQ",
 ``!f:real->real s.
        is_interval s /\ f has_bounded_variation_on s
        ==> ((vector_variation s f = &0) <=> ?c. !x. x IN s ==> (f x = c))``,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [DISCH_TAC THEN REWRITE_TAC [SPECIFICATION] THEN
    REWRITE_TAC[METIS[]
     ``(?c. !x. P x ==> (f x = c)) <=> !a b. P a /\ P b ==> (f a = f b)``] THEN
    MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN STRIP_TAC THEN
    MP_TAC(ISPECL [``f:real->real``, ``s:real->bool``,
        ``a:real``, ``b:real``] VECTOR_VARIATION_GE_ABS_FUNCTION) THEN
    KNOW_TAC ``f has_bounded_variation_on s /\ segment [(a,b)] SUBSET s`` THENL
     [ASM_SIMP_TAC std_ss [] THEN `convex s` by METIS_TAC [IS_INTERVAL_CONVEX] THEN
      FULL_SIMP_TAC std_ss [CONVEX_CONTAINS_SEGMENT] THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC std_ss [SPECIFICATION],
      DISCH_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC],
      ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_TAC ``c:real``) THEN
    MP_TAC(ISPECL [``f:real->real``, ``(\x. c):real->real``,
                   ``s:real->bool``] VECTOR_VARIATION_EQ) THEN
    ASM_SIMP_TAC std_ss [VECTOR_VARIATION_CONST]);

val VECTOR_VARIATION_MONOTONE = store_thm ("VECTOR_VARIATION_MONOTONE",
 ``!f s t. f has_bounded_variation_on s /\ t SUBSET s
           ==> vector_variation t f <= vector_variation s f``,
  REWRITE_TAC[has_bounded_variation_on, vector_variation] THEN
  REWRITE_TAC[SET_VARIATION_MONOTONE]);

val VECTOR_VARIATION_NEG = store_thm ("VECTOR_VARIATION_NEG",
 ``!f:real->real s.
        vector_variation s (\x. -(f x)) = vector_variation s f``,
  REPEAT GEN_TAC THEN REWRITE_TAC[vector_variation, set_variation] THEN
  SIMP_TAC std_ss [REAL_ARITH ``abs(-x - -y:real) = abs(x - y)``]);

val VECTOR_VARIATION_TRIANGLE = store_thm ("VECTOR_VARIATION_TRIANGLE",
 ``!f g:real->real s.
        f has_bounded_variation_on s /\ g has_bounded_variation_on s
        ==> vector_variation s (\x. f x + g x)
              <= vector_variation s f + vector_variation s g``,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[has_bounded_variation_on, vector_variation] THEN
  DISCH_THEN(MP_TAC o MATCH_MP SET_VARIATION_TRIANGLE) THEN
  SIMP_TAC std_ss [REAL_ARITH ``(a + b) - (c + d):real = (a - c) + (b - d)``]);

val HAS_BOUNDED_VARIATION_ON_SUM_AND_SUM_LE = store_thm ("HAS_BOUNDED_VARIATION_ON_SUM_AND_SUM_LE",
 ``(!f:'a->real->real s k.
        FINITE k /\
        (!i. i IN k ==> f i has_bounded_variation_on s)
        ==> (\x. sum k (\i. f i x)) has_bounded_variation_on s) /\
   (!f:'a->real->real s k.
        FINITE k /\
        (!i. i IN k ==> f i has_bounded_variation_on s)
        ==> vector_variation s (\x. sum k (\i. f i x))
            <= sum k (\i. vector_variation s (f i)))``,
  SIMP_TAC std_ss [GSYM FORALL_AND_THM, TAUT
   `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN
  GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
  ONCE_REWRITE_TAC [METIS []
   ``!k. ((!i. i IN k ==> f i has_bounded_variation_on s) ==>
  (\x. sum k (\i. f i x)) has_bounded_variation_on s /\
  vector_variation s (\x. sum k (\i. f i x)) <=
  sum k (\i. vector_variation s (f i))) =
    (\k. (!i. i IN k ==> f i has_bounded_variation_on s) ==>
  (\x. sum k (\i. f i x)) has_bounded_variation_on s /\
  vector_variation s (\x. sum k (\i. f i x)) <=
  sum k (\i. vector_variation s (f i))) k``] THEN
  MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
  SIMP_TAC std_ss [SUM_CLAUSES, FORALL_IN_INSERT] THEN
  SIMP_TAC std_ss [VECTOR_VARIATION_CONST, REAL_LE_REFL,
           HAS_BOUNDED_VARIATION_ON_CONST,
           HAS_BOUNDED_VARIATION_ON_ADD, ETA_AX] THEN
  REPEAT STRIP_TAC THENL
  [ONCE_REWRITE_TAC [METIS [] `` (\x. f e x + sum s' (\i. f i x)) =
                    (\x. (\x. f e x) x + (\x. sum s' (\i. f i x)) x)``] THEN
   MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_ADD THEN
   METIS_TAC [HAS_BOUNDED_VARIATION_ON_ADD, ETA_AX], ALL_TAC] THEN
  ONCE_REWRITE_TAC [METIS [] `` (\x. f e x + sum s' (\i. f i x)) =
                    (\x. (\x. f e x) x + (\x. sum s' (\i. f i x)) x)``] THEN
  W(MP_TAC o PART_MATCH (lhand o rand)
    VECTOR_VARIATION_TRIANGLE o lhand o snd) THEN
  ASM_SIMP_TAC std_ss [METIS [ETA_AX] ``(\x. (f:'a->real->real) e x) = f e``] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
  ASM_SIMP_TAC std_ss [REAL_LE_LADD]);

val HAS_BOUNDED_VARIATION_ON_SUM = store_thm ("HAS_BOUNDED_VARIATION_ON_SUM",
 ``(!f:'a->real->real s k.
        FINITE k /\
        (!i. i IN k ==> f i has_bounded_variation_on s)
        ==> (\x. sum k (\i. f i x)) has_bounded_variation_on s)``,
  REWRITE_TAC [HAS_BOUNDED_VARIATION_ON_SUM_AND_SUM_LE]);

val HAS_BOUNDED_VARIATION_SUM_LE = store_thm ("HAS_BOUNDED_VARIATION_SUM_LE",
 ``(!f:'a->real->real s k.
        FINITE k /\
        (!i. i IN k ==> f i has_bounded_variation_on s)
        ==> vector_variation s (\x. sum k (\i. f i x))
            <= sum k (\i. vector_variation s (f i)))``,
  REWRITE_TAC [HAS_BOUNDED_VARIATION_ON_SUM_AND_SUM_LE]);

Theorem OPERATIVE_FUNCTION_ENDPOINT_DIFF :
    !f:real->real.
      operative (+) (\k. f (interval_upperbound k) - f (interval_lowerbound k))
Proof
  GEN_TAC THEN
  SIMP_TAC std_ss [operative, INTERVAL_BOUNDS_NULL, REAL_SUB_REFL] THEN
  REWRITE_TAC[NEUTRAL_REAL_ADD] THEN
  MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``, ``c:real``] THEN
  ASM_CASES_TAC ``interval[a:real,b] = {}`` THENL
   [ASM_REWRITE_TAC[INTER_EMPTY, INTERVAL_BOUNDS_EMPTY] THEN
    REAL_ARITH_TAC,
    ALL_TAC] THEN
  ASM_CASES_TAC ``interval[a,b] INTER {x | x <= c} = {}`` THENL
   [ASM_REWRITE_TAC[INTERVAL_BOUNDS_EMPTY, REAL_SUB_REFL] THEN
    SUBGOAL_THEN ``interval[a,b] INTER {x | x >= c} = interval[a,b]``
     (fn th => REWRITE_TAC[th, REAL_ADD_LID]) THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     ``(i INTER s = {}) ==> (s UNION t = UNIV) ==> (i INTER t = i)``)) THEN
    SIMP_TAC std_ss [EXTENSION, IN_UNIV, IN_UNION, GSPECIFICATION] THEN
    REAL_ARITH_TAC,
    ALL_TAC] THEN
  ASM_CASES_TAC ``interval[a,b] INTER {x | x >= c} = {}`` THENL
   [ASM_REWRITE_TAC[INTERVAL_BOUNDS_EMPTY, REAL_SUB_REFL] THEN
    SUBGOAL_THEN ``interval[a,b] INTER {x | x <= c} = interval[a,b]``
     (fn th => REWRITE_TAC[th, REAL_ADD_RID]) THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     ``(i INTER s = {}) ==> (s UNION t = UNIV) ==> (i INTER t = i)``)) THEN
    SIMP_TAC std_ss [EXTENSION, IN_UNIV, IN_UNION, GSPECIFICATION] THEN
    REAL_ARITH_TAC,
    ALL_TAC] THEN
  POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
  SIMP_TAC std_ss [INTERVAL_SPLIT, LESS_EQ_REFL] THEN
  REWRITE_TAC[GSYM INTERVAL_EQ_EMPTY, REAL_NOT_LT] THEN
  SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_LOWERBOUND] THEN
  SIMP_TAC std_ss [LESS_EQ_REFL] THEN STRIP_TAC THEN
  MATCH_MP_TAC(REAL_ARITH
   ``(fx:real = fy) ==> (fb - fa = fx - fa + (fb - fy))``) THEN
  AP_TERM_TAC THEN
  FULL_SIMP_TAC std_ss [min_def, max_def] THEN
  Cases_on `b <= c` >> Cases_on `a <= c` >> fs [] \\
  ASM_REAL_ARITH_TAC
QED

val OPERATIVE_REAL_FUNCTION_ENDPOINT_DIFF = store_thm ("OPERATIVE_REAL_FUNCTION_ENDPOINT_DIFF",
 ``!f:real->real.
    operative (+) (\k. f (interval_upperbound k) - f (interval_lowerbound k))``,
  GEN_TAC THEN
  MP_TAC(ISPEC ``(f:real->real)`` OPERATIVE_FUNCTION_ENDPOINT_DIFF) THEN
  REWRITE_TAC[operative, NEUTRAL_REAL_ADD] THEN REWRITE_TAC[o_THM]);

val OPERATIVE_LIFTED_VECTOR_VARIATION = store_thm ("OPERATIVE_LIFTED_VECTOR_VARIATION",
 ``!f:real->real.
        operative (lifted(+))
                  (\i. if f has_bounded_variation_on i
                       then SOME(vector_variation i f) else NONE)``,
  GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on, vector_variation] THEN
  MATCH_MP_TAC OPERATIVE_LIFTED_SETVARIATION THEN
  REWRITE_TAC[OPERATIVE_FUNCTION_ENDPOINT_DIFF]);

val HAS_BOUNDED_VARIATION_ON_DIVISION = store_thm ("HAS_BOUNDED_VARIATION_ON_DIVISION",
 ``!f:real->real a b d.
        d division_of interval[a,b]
        ==> ((!k. k IN d ==> f has_bounded_variation_on k) <=>
             f has_bounded_variation_on interval[a,b])``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN
  MATCH_MP_TAC HAS_BOUNDED_SETVARIATION_ON_DIVISION THEN
  ASM_REWRITE_TAC[OPERATIVE_FUNCTION_ENDPOINT_DIFF]);

val VECTOR_VARIATION_ON_DIVISION = store_thm ("VECTOR_VARIATION_ON_DIVISION",
 ``!f:real->real a b d.
        d division_of interval[a,b] /\
        f has_bounded_variation_on interval[a,b]
        ==> (sum d (\k. vector_variation k f) =
             vector_variation (interval[a,b]) f)``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[vector_variation] THEN
  MATCH_MP_TAC SET_VARIATION_ON_DIVISION THEN
  ASM_REWRITE_TAC[OPERATIVE_FUNCTION_ENDPOINT_DIFF, GSYM
                  has_bounded_variation_on]);

val HAS_BOUNDED_VARIATION_ON_COMBINE = store_thm ("HAS_BOUNDED_VARIATION_ON_COMBINE",
 ``!f:real->real a b c.
        a <= c /\ c <= b
        ==> (f has_bounded_variation_on interval[a,b] <=>
             f has_bounded_variation_on interval[a,c] /\
             f has_bounded_variation_on interval[c,b])``,
  REPEAT STRIP_TAC THEN MP_TAC
   (ISPEC ``f:real->real`` OPERATIVE_LIFTED_VECTOR_VARIATION) THEN
  REWRITE_TAC[operative] THEN
  DISCH_THEN(MP_TAC o SPECL [``a:real``, ``b:real``, ``c:real``] o
   CONJUNCT2) THEN ASM_SIMP_TAC std_ss [] THEN
  SUBGOAL_THEN
   ``(interval[a,b] INTER {x:real | x <= c} = interval[a,c]) /\
     (interval[a,b] INTER {x:real | x >= c} = interval[c,b])``
   (fn th => REWRITE_TAC[th])
  THENL
   [SIMP_TAC std_ss [EXTENSION, IN_INTER, IN_INTERVAL, GSPECIFICATION] THEN
    ASM_REAL_ARITH_TAC,
    REPEAT(COND_CASES_TAC THEN
           ASM_SIMP_TAC std_ss [NOT_NONE_SOME, lifted])]);

Theorem VECTOR_VARIATION_COMBINE :
    !f:real->real a b c.
        a <= c /\ c <= b /\
        f has_bounded_variation_on interval[a,b]
        ==> (vector_variation (interval[a,c]) f +
             vector_variation (interval[c,b]) f =
             vector_variation (interval[a,b]) f)
Proof
  REPEAT STRIP_TAC THEN MP_TAC
   (ISPEC ``f:real->real`` OPERATIVE_LIFTED_VECTOR_VARIATION) THEN
  REWRITE_TAC[operative] THEN
  DISCH_THEN(MP_TAC o SPECL [``a:real``, ``b:real``, ``c:real``] o
   CONJUNCT2) THEN ASM_SIMP_TAC std_ss [] THEN REPEAT(COND_CASES_TAC THENL
    [ALL_TAC,
     ASM_MESON_TAC[HAS_BOUNDED_VARIATION_ON_SUBSET, INTER_SUBSET]]) THEN
  REWRITE_TAC[lifted, SOME_11] THEN DISCH_THEN SUBST1_TAC THEN
  SIMP_TAC std_ss [INTERVAL_SPLIT, LESS_EQ_REFL] THEN
  BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
  SIMP_TAC std_ss [EXTENSION, IN_INTERVAL, LESS_EQ_REFL] THEN
  RW_TAC real_ss [min_def, max_def] THEN ASM_REAL_ARITH_TAC
QED

val VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE = store_thm ("VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE",
 ``!f a b c d.
        f has_bounded_variation_on interval[a,b] /\
        interval[c,d] SUBSET interval[a,b] /\ ~(interval[c,d] = {})
        ==> vector_variation (interval[c,d]) f - (f d - f c) <=
            vector_variation (interval[a,b]) f - (f b - f a)``,
  REWRITE_TAC[SUBSET_INTERVAL, GSYM INTERVAL_EQ_EMPTY, REAL_NOT_LT] THEN
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   ``(f c) - (f a) <= vector_variation(interval[a,c]) f /\
     (f b) - (f d) <= vector_variation(interval[d,b]) f``
  MP_TAC THENL
   [CONJ_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_GE_FUNCTION THEN
    ASM_SIMP_TAC std_ss [SEGMENT, SUBSET_INTERVAL, GSYM INTERVAL_EQ_EMPTY] THEN
    (CONJ_TAC THENL [ALL_TAC, ASM_REAL_ARITH_TAC]) THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
      HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN
    REWRITE_TAC[SUBSET_INTERVAL] THEN ASM_REAL_ARITH_TAC,
    ALL_TAC] THEN
  MP_TAC(ISPEC ``f:real->real`` VECTOR_VARIATION_COMBINE) THEN
  DISCH_THEN(fn th =>
    MP_TAC(SPECL [``a:real``, ``b:real``, ``d:real``] th) THEN
    MP_TAC(SPECL [``a:real``, ``d:real``, ``c:real``] th)) THEN
  ASM_SIMP_TAC std_ss [] THEN
  KNOW_TAC ``(f :real -> real) has_bounded_variation_on
              interval [((a :real),(d :real))]`` THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
     HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN
    REWRITE_TAC[SUBSET_INTERVAL] THEN ASM_REAL_ARITH_TAC,
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    ASM_REAL_ARITH_TAC]);

val HAS_BOUNDED_VARIATION_NONTRIVIAL = store_thm ("HAS_BOUNDED_VARIATION_NONTRIVIAL",
 ``!f:real->real s.
        f has_bounded_variation_on s <=>
        ?B. !d t.
                  d division_of t /\ t SUBSET s /\
                  (!k. k IN d ==> ~(interior k = {}))
                  ==> sum d (\k. abs(f(interval_upperbound k) -
                                      f (interval_lowerbound k))) <= B``,
  REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN
  REWRITE_TAC[has_bounded_setvariation_on] THEN
  AP_TERM_TAC THEN GEN_REWR_TAC I [FUN_EQ_THM] THEN
  X_GEN_TAC ``B:real`` THEN SIMP_TAC std_ss [] THEN
  EQ_TAC THENL [METIS_TAC[], DISCH_TAC] THEN
  MAP_EVERY X_GEN_TAC [``d:(real->bool)->bool``, ``t:real->bool``] THEN
  STRIP_TAC THEN
  ABBREV_TAC ``d' = {k:real->bool | k IN d /\ ~(interior k = {})}`` THEN
  FIRST_X_ASSUM(MP_TAC o SPECL
   [``d':(real->bool)->bool``, ``BIGUNION d':real->bool``]) THEN
  KNOW_TAC ``(d' :(real -> bool) -> bool) division_of BIGUNION d' /\
    BIGUNION d' SUBSET (s :real -> bool) /\
   (!(k :real -> bool). k IN d' ==> interior k <> ({} :real -> bool))`` THENL
   [EXPAND_TAC "d'" THEN SIMP_TAC std_ss [GSPECIFICATION] THEN CONJ_TAC THENL
     [MATCH_MP_TAC DIVISION_OF_SUBSET THEN
      EXISTS_TAC ``d:(real->bool)->bool`` THEN
      SIMP_TAC std_ss [SUBSET_RESTRICT] THEN ASM_MESON_TAC[DIVISION_OF_UNION_SELF],
      MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC ``t:real->bool`` THEN ASM_SIMP_TAC std_ss [] THEN
      MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC ``BIGUNION d:real->bool`` THEN CONJ_TAC THENL
       [MATCH_MP_TAC SUBSET_BIGUNION THEN ASM_SET_TAC[],
        ASM_MESON_TAC[division_of, SUBSET_REFL]]],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    MATCH_MP_TAC(REAL_ARITH ``(y:real = x) ==> x <= b ==> y <= b``) THEN
    MATCH_MP_TAC SUM_SUPERSET THEN EXPAND_TAC "d'" THEN
    ASM_SIMP_TAC real_ss [SUBSET_RESTRICT, GSPECIFICATION, TAUT
     `p /\ ~(p /\ ~q) ==> r <=> p ==> q ==> r`] THEN
    GEN_TAC THEN STRIP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
    UNDISCH_TAC ``d division_of t`` THEN DISCH_TAC THEN
    SPEC_TAC (``x:real->bool``,``x:real->bool``) THEN
    FIRST_ASSUM(fn th =>
     SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN
    SIMP_TAC std_ss [INTERVAL_LOWERBOUND_NONEMPTY, INTERVAL_UPPERBOUND_NONEMPTY] THEN
    SIMP_TAC std_ss [INTERIOR_INTERVAL, INTERVAL_NE_EMPTY] THEN
    SIMP_TAC std_ss [GSYM INTERVAL_EQ_EMPTY, AND_IMP_INTRO, GSYM CONJ_ASSOC] THEN
    SIMP_TAC std_ss [REAL_LE_ANTISYM, REAL_SUB_REFL, ABS_0]]);

val INCREASING_BOUNDED_VARIATION_GEN = store_thm ("INCREASING_BOUNDED_VARIATION_GEN",
 ``!f s.
      bounded(IMAGE f s) /\
      (!x y. x IN s /\ y IN s /\ x <= y ==> (f x) <= (f y))
       ==> f has_bounded_variation_on s``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_NONTRIVIAL] THEN
  UNDISCH_TAC ``(bounded (IMAGE (f :real -> real) (s :real -> bool)) :bool)`` THEN
  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [BOUNDED_POS]) THEN
  SIMP_TAC std_ss [FORALL_IN_IMAGE] THEN
  DISCH_THEN(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC ``&2 * B:real`` THEN REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [``d:(real->bool)->bool``, ``t:real->bool``]
        DIVISION_1_SORT) THEN
  ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [``n:num``, ``t:num->real->bool``] THEN STRIP_TAC THEN
  EXPAND_TAC "d" THEN
  KNOW_TAC ``sum ((1:num)..n)
    ((\k. abs (f (interval_upperbound k) - f (interval_lowerbound k))) o t) <=
     &2 * (B:real) /\
    (!x y. x IN ((1:num)..n) /\ y IN ((1:num)..n) /\ (t x = t y) ==> (x = y))`` THENL
  [ALL_TAC, METIS_TAC [SUM_IMAGE]] THEN
  CONJ_TAC THENL [SIMP_TAC std_ss [o_DEF], ASM_MESON_TAC[LT_CASES]] THEN
  SUBGOAL_THEN
   ``!k. k IN d
        ==> interval_lowerbound (k:real->bool) IN k INTER s /\
            interval_upperbound k IN k INTER s /\
            (interval_lowerbound k) <= (interval_upperbound k)``
  MP_TAC THENL
   [UNDISCH_TAC ``d division_of t`` THEN DISCH_TAC THEN
    FIRST_ASSUM(fn th =>
      SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN
    SIMP_TAC std_ss [INTERVAL_LOWERBOUND_NONEMPTY, INTERVAL_UPPERBOUND_NONEMPTY] THEN
    REWRITE_TAC[IN_INTER] THEN
    ASM_MESON_TAC[division_of, ENDS_IN_INTERVAL, SUBSET_DEF, INTERVAL_NE_EMPTY],
    EXPAND_TAC "d" THEN SIMP_TAC std_ss [FORALL_IN_IMAGE, IN_INTER] THEN
    STRIP_TAC] THEN
  SUBGOAL_THEN
   ``!m. 1 <= m /\ m <= n
        ==> sum((1:num)..m) (\i. abs(f(interval_upperbound(t i)) -
                                (f:real->real)(interval_lowerbound(t i))))
            <= (f(interval_upperbound(t m))) - (f(interval_lowerbound(t 1)))``
   (MP_TAC o SPEC ``n:num``)
  THENL
   [KNOW_TAC ``!(m :num).
     (\m. (1 :num) <= m /\ m <= (n :num) ==>
    sum ((1 :num) .. m)
      (\(i :num).  abs
         ((f :real -> real)
            (interval_upperbound ((t :num -> real -> bool) i)) -
          f (interval_lowerbound (t i)))) <=
    f (interval_upperbound (t m)) - f (interval_lowerbound (t (1 :num)))) m`` THENL
    [ALL_TAC, METIS_TAC []] THEN
    MATCH_MP_TAC INDUCTION THEN
    SIMP_TAC arith_ss [SUM_CLAUSES_NUMSEG] THEN
    X_GEN_TAC ``m:num`` THEN
    ASM_CASES_TAC ``m = 0:num`` THEN ASM_SIMP_TAC arith_ss [SUM_CLAUSES_NUMSEG] THENL
     [DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH ``(x = y) ==> &0 + x <= y:real``) THEN
      MATCH_MP_TAC(REAL_ARITH
       ``y <= x ==> (abs(x - y) = x - y:real)``) THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[IN_NUMSEG, LESS_EQ_REFL],
      DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN
      KNOW_TAC ``1 <= SUC m:num`` THENL [ASM_SIMP_TAC arith_ss [], DISCH_TAC] THEN
      KNOW_TAC ``m <= n:num`` THENL
      [ASM_SIMP_TAC arith_ss [], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
       POP_ASSUM K_TAC] THEN MATCH_MP_TAC(REAL_ARITH
       ``b + x <= y ==> s <= b ==> s + x <= y:real``) THEN
      MATCH_MP_TAC(REAL_ARITH
       ``um <= ls /\ ls <= us ==> (um - l1) + abs(us - ls) <= us - l1:real``) THEN
      CONJ_TAC THENL
       [FIRST_X_ASSUM MATCH_MP_TAC, METIS_TAC[IN_NUMSEG]] THEN
      REPEAT(CONJ_TAC THENL
       [ASM_MESON_TAC[IN_NUMSEG, LE_1, ARITH_PROVE ``SUC m <= n ==> m <= n``],
       ALL_TAC]) THEN
      FIRST_X_ASSUM(MP_TAC o SPECL [``m:num``, ``SUC m``]) THEN
      REWRITE_TAC[IN_NUMSEG] THEN
      KNOW_TAC ``(1 <= m /\ m <= n) /\ (1 <= SUC m /\ SUC m <= n) /\ m < SUC m`` THENL
      [ASM_SIMP_TAC arith_ss [], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
       POP_ASSUM K_TAC THEN DISCH_THEN(MATCH_MP_TAC o CONJUNCT2)] THEN
      ASM_MESON_TAC[IN_NUMSEG, LE_1, ARITH_PROVE ``SUC m <= n ==> m <= n``]],
    ASM_CASES_TAC ``n = 0:num`` THENL
     [ASM_SIMP_TAC arith_ss [SUM_CLAUSES_NUMSEG] THEN
      UNDISCH_TAC ``0 < B:real`` THEN REAL_ARITH_TAC,
      ASM_SIMP_TAC std_ss [LE_1, LESS_EQ_REFL]] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
    MATCH_MP_TAC(REAL_ARITH ``(abs(x) <= B /\ abs(y) <= B)
      ==> x - y <= &2 * B:real``) THEN
    CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_MESON_TAC[IN_NUMSEG, LESS_EQ_REFL, LE_1]]);

val DECREASING_BOUNDED_VARIATION_GEN = store_thm ("DECREASING_BOUNDED_VARIATION_GEN",
 ``!f s.
      bounded(IMAGE f s) /\
      (!x y. x IN s /\ y IN s /\ x <= y ==> (f y) <= (f x))
       ==> f has_bounded_variation_on s``,
  REPEAT STRIP_TAC THEN
  MP_TAC(SPECL [``(\x. -x) o (f:real->real)``, ``s:real->bool``]
        INCREASING_BOUNDED_VARIATION_GEN) THEN
  ASM_SIMP_TAC std_ss [REAL_LE_NEG2] THEN
  ASM_SIMP_TAC std_ss [BOUNDED_NEGATIONS, IMAGE_COMPOSE] THEN
  DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_NEG) THEN
  METIS_TAC[o_DEF, REAL_NEG_NEG, ETA_AX]);

Theorem INCREASING_BOUNDED_VARIATION :
    !f a b.
        (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
               ==> (f x) <= (f y))
        ==> f has_bounded_variation_on interval[a,b]
Proof
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INCREASING_BOUNDED_VARIATION_GEN THEN
  ASM_SIMP_TAC std_ss [bounded_def, FORALL_IN_IMAGE] THEN EXISTS_TAC
   ``max (abs((f:real->real) a)) (abs((f:real->real) b))`` THEN
  X_GEN_TAC ``x:real`` THEN DISCH_TAC THEN FIRST_X_ASSUM(fn th =>
    MP_TAC(SPECL [``a:real``, ``x:real``] th) THEN
    MP_TAC(SPECL [``x:real``, ``b:real``] th)) THEN
  ASM_SIMP_TAC std_ss [ENDS_IN_INTERVAL, INTERVAL_NE_EMPTY] THEN
  FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [IN_INTERVAL]) THEN
  RW_TAC real_ss [max_def] THEN
 `a <= b` by PROVE_TAC [REAL_LE_TRANS] >> RES_TAC \\
  REAL_ASM_ARITH_TAC
QED

val DECREASING_BOUNDED_VARIATION = store_thm ("DECREASING_BOUNDED_VARIATION",
 ``!f a b.
        (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
               ==> (f y) <= (f x))
         ==> f has_bounded_variation_on interval[a,b]``,
  REPEAT GEN_TAC THEN
  GEN_REWR_TAC (LAND_CONV o BINDER_CONV o BINDER_CONV o RAND_CONV)
   [GSYM REAL_LE_NEG2] THEN
  SIMP_TAC std_ss [] THEN
  GEN_REWR_TAC (LAND_CONV o BINDER_CONV o BINDER_CONV o RAND_CONV)
   [METIS [] ``-f x <= -f y <=> (\x. -f x) x <= (\y. -f y) y:real``] THEN
  DISCH_THEN(MP_TAC o MATCH_MP INCREASING_BOUNDED_VARIATION) THEN
  DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_NEG) THEN
  SIMP_TAC std_ss [REAL_NEG_NEG] THEN METIS_TAC [ETA_AX]);

val INCREASING_VECTOR_VARIATION = store_thm ("INCREASING_VECTOR_VARIATION",
 ``!f a b.
        ~(interval[a,b] = {}) /\
        (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
               ==> (f x) <= (f y))
        ==> (vector_variation (interval[a,b]) f = (f b) - (f a))``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[vector_variation] THEN
  REWRITE_TAC[SET_VARIATION_ON_INTERVAL] THEN
  SUBGOAL_THEN
   ``{sum d (\k. abs (f (interval_upperbound k) - f (interval_lowerbound k))) |
     d division_of interval[a:real,b]} =
    {(f b) - (f a)}``
   (fn th => SIMP_TAC std_ss [SUP_INSERT_FINITE, FINITE_EMPTY, th]) THEN
  ONCE_REWRITE_TAC [METIS [] ``{sum d f | d division_of interval [(a,b)]} =
                  {(\d. sum d f) d | (\d. d division_of interval [(a,b)]) d}``] THEN
  MATCH_MP_TAC(SET_RULE
   ``(?x. P x) /\ (!x. P x ==> (f x = a)) ==> ({f x | P x} = {a})``) THEN
  CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_SELF], ALL_TAC] THEN
  MP_TAC(MATCH_MP (REWRITE_RULE
   [TAUT `a /\ b /\ c ==> d <=> b ==> a /\ c ==> d`]
   OPERATIVE_DIVISION) (SPEC ``(f:real->real)``
      OPERATIVE_REAL_FUNCTION_ENDPOINT_DIFF)) THEN
   DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o SPEC ``x:(real->bool)->bool``) THEN
  DISCH_THEN(MP_TAC o SPECL [``a:real``, ``b:real``]) THEN
  DISCH_THEN(fn th => STRIP_TAC THEN MP_TAC th) THEN
  ASM_REWRITE_TAC[GSYM sum_def, MONOIDAL_REAL_ADD] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[GSYM INTERVAL_EQ_EMPTY, REAL_NOT_LT]) THEN
  FULL_SIMP_TAC std_ss [o_THM, INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND] THEN
  DISCH_THEN(SUBST1_TAC o SYM) THEN
  MATCH_MP_TAC SUM_EQ THEN SIMP_TAC std_ss [] THEN
  FIRST_ASSUM(fn th => SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
  MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN DISCH_TAC THEN
  SUBGOAL_THEN ``~(interval[u:real,v] = {})`` ASSUME_TAC THENL
   [ASM_MESON_TAC[division_of], ALL_TAC] THEN
   RULE_ASSUM_TAC(REWRITE_RULE[GSYM INTERVAL_EQ_EMPTY, REAL_NOT_LT]) THEN
  ASM_SIMP_TAC std_ss [INTERVAL_LOWERBOUND, INTERVAL_UPPERBOUND] THEN
  MATCH_MP_TAC(REAL_ARITH ``x <= y ==> (abs(y - x) = y - x:real)``) THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN
  SUBGOAL_THEN ``interval[u:real,v] SUBSET interval[a,b]`` MP_TAC THENL
   [ASM_MESON_TAC[division_of], REWRITE_TAC[SUBSET_INTERVAL]] THEN
  ASM_REAL_ARITH_TAC);

val DECREASING_VECTOR_VARIATION = store_thm ("DECREASING_VECTOR_VARIATION",
 ``!f a b.
        ~(interval[a,b] = {}) /\
        (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
               ==> (f y) <= (f x))
        ==> (vector_variation (interval[a,b]) f = (f a) - (f b))``,
  REPEAT GEN_TAC THEN GEN_REWR_TAC
   (LAND_CONV o RAND_CONV o BINDER_CONV o BINDER_CONV o RAND_CONV)
   [GSYM REAL_LE_NEG2] THEN
  GEN_REWR_TAC
   (LAND_CONV o RAND_CONV o BINDER_CONV o BINDER_CONV o RAND_CONV)
   [METIS [] ``-f x <= -f y <=> (\x. -f x) x <= (\y. -(f:real->real) y) y``] THEN
  DISCH_THEN(MP_TAC o MATCH_MP INCREASING_VECTOR_VARIATION) THEN
  SIMP_TAC std_ss [VECTOR_VARIATION_NEG] THEN
  DISCH_TAC THEN REAL_ARITH_TAC);

val HAS_BOUNDED_VARIATION_TRANSLATION2_EQ_AND_VECTOR_VARIATION_TRANSLATION2 = store_thm ("HAS_BOUNDED_VARIATION_TRANSLATION2_EQ_AND_VECTOR_VARIATION_TRANSLATION2",
 ``(!a f:real->real s.
        (\x. f(a + x)) has_bounded_variation_on (IMAGE (\x. -a + x) s) <=>
        f has_bounded_variation_on s) /\
   (!a f:real->real s.
        vector_variation (IMAGE (\x. -a + x) s) (\x. f(a + x)) =
        vector_variation s f)``,
  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN X_GEN_TAC ``a:real`` THEN
  SIMP_TAC std_ss [FORALL_AND_THM] THEN
  ONCE_REWRITE_TAC [METIS [] ``(\x. f (a + x:real)) = (\x. f ((\x. (a + x)) x))``] THEN
  MATCH_MP_TAC VARIATION_EQUAL_LEMMA THEN
  SIMP_TAC std_ss [] THEN CONJ_TAC THENL [REAL_ARITH_TAC, ALL_TAC] THEN
  SIMP_TAC std_ss [DIVISION_OF_TRANSLATION, GSYM INTERVAL_TRANSLATION]);

val HAS_BOUNDED_VARIATION_TRANSLATION2_EQ = store_thm ("HAS_BOUNDED_VARIATION_TRANSLATION2_EQ",
 ``(!a f:real->real s.
        (\x. f(a + x)) has_bounded_variation_on (IMAGE (\x. -a + x) s) <=>
        f has_bounded_variation_on s)``,
  REWRITE_TAC [HAS_BOUNDED_VARIATION_TRANSLATION2_EQ_AND_VECTOR_VARIATION_TRANSLATION2]);

val VECTOR_VARIATION_TRANSLATION2 = store_thm ("VECTOR_VARIATION_TRANSLATION2",
 ``(!a f:real->real s.
        vector_variation (IMAGE (\x. -a + x) s) (\x. f(a + x)) =
        vector_variation s f)``,
  REWRITE_TAC [HAS_BOUNDED_VARIATION_TRANSLATION2_EQ_AND_VECTOR_VARIATION_TRANSLATION2]);

val HAS_BOUNDED_VARIATION_AFFINITY2_EQ_AND_VECTOR_VARIATION_AFFINITY2 = store_thm ("HAS_BOUNDED_VARIATION_AFFINITY2_EQ_AND_VECTOR_VARIATION_AFFINITY2",
 ``(!m c f:real->real s.
        (\x. f (m * x + c)) has_bounded_variation_on
        IMAGE (\x. inv m * x + -(inv m * c)) s <=>
        (m = &0) \/ f has_bounded_variation_on s) /\
   (!m c f:real->real s.
        vector_variation (IMAGE (\x. inv m * x + -(inv m * c)) s)
                         (\x. f (m * x + c)) =
        if m = &0 then &0 else vector_variation s f)``,
  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN X_GEN_TAC ``m:real`` THEN
  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN X_GEN_TAC ``c:real`` THEN
  ASM_CASES_TAC ``m = &0:real`` THEN ASM_SIMP_TAC std_ss [] THENL
   [ASM_SIMP_TAC std_ss [REAL_MUL_LZERO, HAS_BOUNDED_VARIATION_ON_CONST] THEN
    SIMP_TAC std_ss [VECTOR_VARIATION_CONST],
    SIMP_TAC std_ss [FORALL_AND_THM] THEN
    ONCE_REWRITE_TAC [METIS [] ``(\x:real. f (m * x + c)) = (\x. f ((\x. (m * x + c)) x))``] THEN
    MATCH_MP_TAC VARIATION_EQUAL_LEMMA THEN
    ASM_SIMP_TAC std_ss [SIMP_RULE std_ss [FUN_EQ_THM, o_DEF] AFFINITY_INVERSES] THEN
    ASM_SIMP_TAC std_ss [IMAGE_AFFINITY_INTERVAL] THEN
    ASM_SIMP_TAC real_ss [DIVISION_OF_AFFINITY, REAL_INV_EQ_0] THEN
    METIS_TAC[]]);

val HAS_BOUNDED_VARIATION_AFFINITY2_EQ = store_thm ("HAS_BOUNDED_VARIATION_AFFINITY2_EQ",
 ``(!m c f:real->real s.
        (\x. f (m * x + c)) has_bounded_variation_on
        IMAGE (\x. inv m * x + -(inv m * c)) s <=>
        (m = &0) \/ f has_bounded_variation_on s)``,
  REWRITE_TAC [HAS_BOUNDED_VARIATION_AFFINITY2_EQ_AND_VECTOR_VARIATION_AFFINITY2]);

val VECTOR_VARIATION_AFFINITY2 = store_thm ("VECTOR_VARIATION_AFFINITY2",
 `` (!m c f:real->real s.
        vector_variation (IMAGE (\x. inv m * x + -(inv m * c)) s)
                         (\x. f (m * x + c)) =
        if m = &0 then &0 else vector_variation s f)``,
  REWRITE_TAC [HAS_BOUNDED_VARIATION_AFFINITY2_EQ_AND_VECTOR_VARIATION_AFFINITY2]);

val HAS_BOUNDED_VARIATION_AFFINITY_EQ_AND_VECTOR_VARIATION_AFFINITY = store_thm ("HAS_BOUNDED_VARIATION_AFFINITY_EQ_AND_VECTOR_VARIATION_AFFINITY",
 ``(!m c f:real->real s.
        (\x. f(m * x + c)) has_bounded_variation_on s <=>
        (m = &0) \/ f has_bounded_variation_on (IMAGE (\x. m * x + c) s)) /\
   (!m c f:real->real s.
        vector_variation s (\x. f(m * x + c)) =
        if m = &0 then &0 else vector_variation (IMAGE (\x. m * x + c) s) f)``,
  SIMP_TAC std_ss [GSYM FORALL_AND_THM] THEN REPEAT GEN_TAC THEN
  ASM_CASES_TAC ``m = &0:real`` THEN
  ASM_SIMP_TAC real_ss [REAL_MUL_LZERO, HAS_BOUNDED_VARIATION_ON_CONST,
                  VECTOR_VARIATION_CONST] THEN
  CONJ_TAC THENL
   [MP_TAC(ISPECL[``m:real``, ``c:real``, ``f:real->real``,
                  ``IMAGE (\x:real. m * x + c) s``]
          HAS_BOUNDED_VARIATION_AFFINITY2_EQ),
    MP_TAC(ISPECL[``m:real``, ``c:real``, ``f:real->real``,
                  ``IMAGE (\x:real. m * x + c) s``]
          VECTOR_VARIATION_AFFINITY2)] THEN
  ASM_SIMP_TAC std_ss [AFFINITY_INVERSES, GSYM IMAGE_COMPOSE, IMAGE_ID]);

val HAS_BOUNDED_VARIATION_AFFINITY_EQ = store_thm ("HAS_BOUNDED_VARIATION_AFFINITY_EQ",
 ``(!m c f:real->real s.
        (\x. f(m * x + c)) has_bounded_variation_on s <=>
        (m = &0) \/ f has_bounded_variation_on (IMAGE (\x. m * x + c) s))``,
  REWRITE_TAC [HAS_BOUNDED_VARIATION_AFFINITY_EQ_AND_VECTOR_VARIATION_AFFINITY]);

val VECTOR_VARIATION_AFFINITY = store_thm ("VECTOR_VARIATION_AFFINITY",
 ``(!m c f:real->real s.
        vector_variation s (\x. f(m * x + c)) =
        if m = &0 then &0 else vector_variation (IMAGE (\x. m * x + c) s) f)``,
  REWRITE_TAC [HAS_BOUNDED_VARIATION_AFFINITY_EQ_AND_VECTOR_VARIATION_AFFINITY]);

val HAS_BOUNDED_VARIATION_TRANSLATION_EQ_AND_VECTOR_VARIATION_TRANSLATION = store_thm ("HAS_BOUNDED_VARIATION_TRANSLATION_EQ_AND_VECTOR_VARIATION_TRANSLATION",
 ``(!a f:real->real s.
        (\x. f(a + x)) has_bounded_variation_on s <=>
        f has_bounded_variation_on (IMAGE (\x. a + x) s)) /\
   (!a f:real->real s.
        vector_variation s (\x. f(a + x)) =
        vector_variation (IMAGE (\x. a + x) s) f)``,
  REPEAT STRIP_TAC THENL
   [MP_TAC(ISPECL[``a:real``, ``f:real->real``, ``IMAGE (\x:real. a + x) s``]
          HAS_BOUNDED_VARIATION_TRANSLATION2_EQ),
    MP_TAC(ISPECL[``a:real``, ``f:real->real``, ``IMAGE (\x:real. a + x) s``]
          VECTOR_VARIATION_TRANSLATION2)] THEN
  SIMP_TAC std_ss [GSYM IMAGE_COMPOSE, o_DEF] THEN
  SIMP_TAC real_ss [IMAGE_ID, REAL_ARITH ``-a + (a + x):real = x``,
              REAL_ARITH ``a + -a + x:real = x``]);

val HAS_BOUNDED_VARIATION_TRANSLATION_EQ = store_thm ("HAS_BOUNDED_VARIATION_TRANSLATION_EQ",
 ``(!a f:real->real s.
        (\x. f(a + x)) has_bounded_variation_on s <=>
        f has_bounded_variation_on (IMAGE (\x. a + x) s))``,
  REWRITE_TAC [HAS_BOUNDED_VARIATION_TRANSLATION_EQ_AND_VECTOR_VARIATION_TRANSLATION]);

val VECTOR_VARIATION_TRANSLATION = store_thm ("VECTOR_VARIATION_TRANSLATION",
 ``(!a f:real->real s.
        vector_variation s (\x. f(a + x)) =
        vector_variation (IMAGE (\x. a + x) s) f)``,
  REWRITE_TAC [HAS_BOUNDED_VARIATION_TRANSLATION_EQ_AND_VECTOR_VARIATION_TRANSLATION]);

val HAS_BOUNDED_VARIATION_TRANSLATION_EQ_INTERVAL_AND_VECTOR_VARIATION_TRANSLATION_INTERVAL = store_thm ("HAS_BOUNDED_VARIATION_TRANSLATION_EQ_INTERVAL_AND_VECTOR_VARIATION_TRANSLATION_INTERVAL",
 ``(!a f:real->real u v.
        (\x. f(a + x)) has_bounded_variation_on interval[u,v] <=>
        f has_bounded_variation_on interval[a+u,a+v]) /\
   (!a f:real->real u v.
        vector_variation (interval[u,v]) (\x. f(a + x)) =
        vector_variation (interval[a+u,a+v]) f)``,
  SIMP_TAC std_ss [INTERVAL_TRANSLATION, HAS_BOUNDED_VARIATION_TRANSLATION_EQ,
              VECTOR_VARIATION_TRANSLATION]);

val HAS_BOUNDED_VARIATION_TRANSLATION_EQ_INTERVAL = store_thm ("HAS_BOUNDED_VARIATION_TRANSLATION_EQ_INTERVAL",
 ``(!a f:real->real u v.
        (\x. f(a + x)) has_bounded_variation_on interval[u,v] <=>
        f has_bounded_variation_on interval[a+u,a+v])``,
 REWRITE_TAC [HAS_BOUNDED_VARIATION_TRANSLATION_EQ_INTERVAL_AND_VECTOR_VARIATION_TRANSLATION_INTERVAL]);

val VECTOR_VARIATION_TRANSLATION_INTERVAL = store_thm ("VECTOR_VARIATION_TRANSLATION_INTERVAL",
 ``(!a f:real->real u v.
        vector_variation (interval[u,v]) (\x. f(a + x)) =
        vector_variation (interval[a+u,a+v]) f)``,
 REWRITE_TAC [HAS_BOUNDED_VARIATION_TRANSLATION_EQ_INTERVAL_AND_VECTOR_VARIATION_TRANSLATION_INTERVAL]);

val HAS_BOUNDED_VARIATION_TRANSLATION = store_thm ("HAS_BOUNDED_VARIATION_TRANSLATION",
 ``!f:real->real s a.
        f has_bounded_variation_on s
        ==> (\x. f(a + x)) has_bounded_variation_on (IMAGE (\x. -a + x) s)``,
  REWRITE_TAC[HAS_BOUNDED_VARIATION_TRANSLATION2_EQ]);

val HAS_BOUNDED_VARIATION_REFLECT2_EQ_AND_VECTOR_VARIATION_REFLECT2 = store_thm ("HAS_BOUNDED_VARIATION_REFLECT2_EQ_AND_VECTOR_VARIATION_REFLECT2",
 ``(!f:real->real s.
        (\x. f(-x)) has_bounded_variation_on (IMAGE (\x. -x) s) <=>
        f has_bounded_variation_on s) /\
   (!f:real->real s.
        vector_variation (IMAGE (\x. -x) s) (\x. f(-x)) =
        vector_variation s f)``,
  MATCH_MP_TAC VARIATION_EQUAL_LEMMA THEN
  SIMP_TAC std_ss [] THEN CONJ_TAC THENL [REAL_ARITH_TAC, ALL_TAC] THEN
  METIS_TAC [DIVISION_OF_REFLECT, REFLECT_INTERVAL]);

val HAS_BOUNDED_VARIATION_REFLECT2_EQ = store_thm ("HAS_BOUNDED_VARIATION_REFLECT2_EQ",
 ``(!f:real->real s.
        (\x. f(-x)) has_bounded_variation_on (IMAGE (\x. -x) s) <=>
        f has_bounded_variation_on s)``,
  REWRITE_TAC [HAS_BOUNDED_VARIATION_REFLECT2_EQ_AND_VECTOR_VARIATION_REFLECT2]);

val VECTOR_VARIATION_REFLECT2 = store_thm ("VECTOR_VARIATION_REFLECT2",
 ``(!f:real->real s.
        vector_variation (IMAGE (\x. -x) s) (\x. f(-x)) =
        vector_variation s f)``,
  REWRITE_TAC [HAS_BOUNDED_VARIATION_REFLECT2_EQ_AND_VECTOR_VARIATION_REFLECT2]);

val HAS_BOUNDED_VARIATION_REFLECT_EQ_AND_VECTOR_VARIATION_REFLECT = store_thm ("HAS_BOUNDED_VARIATION_REFLECT_EQ_AND_VECTOR_VARIATION_REFLECT",
 ``(!f:real->real s.
        (\x. f(-x)) has_bounded_variation_on s <=>
        f has_bounded_variation_on (IMAGE (\x. -x) s)) /\
   (!f:real->real s.
        vector_variation s (\x. f(-x)) =
        vector_variation (IMAGE (\x. -x) s) f)``,
  REPEAT STRIP_TAC THENL
   [MP_TAC(ISPECL[``f:real->real``, ``IMAGE (\x. -x) (s:real->bool)``]
          HAS_BOUNDED_VARIATION_REFLECT2_EQ),
    MP_TAC(ISPECL[``f:real->real``, ``IMAGE (\x. -x) (s:real->bool)``]
          VECTOR_VARIATION_REFLECT2)] THEN
  SIMP_TAC std_ss [GSYM IMAGE_COMPOSE, o_DEF] THEN
  REWRITE_TAC[IMAGE_ID, REAL_NEG_NEG]);

val HAS_BOUNDED_VARIATION_REFLECT_EQ = store_thm ("HAS_BOUNDED_VARIATION_REFLECT_EQ",
 ``(!f:real->real s.
        (\x. f(-x)) has_bounded_variation_on s <=>
        f has_bounded_variation_on (IMAGE (\x. -x) s))``,
  REWRITE_TAC [HAS_BOUNDED_VARIATION_REFLECT_EQ_AND_VECTOR_VARIATION_REFLECT]);

val VECTOR_VARIATION_REFLECT = store_thm ("VECTOR_VARIATION_REFLECT",
 ``(!f:real->real s.
        vector_variation s (\x. f(-x)) =
        vector_variation (IMAGE (\x. -x) s) f)``,
  REWRITE_TAC [HAS_BOUNDED_VARIATION_REFLECT_EQ_AND_VECTOR_VARIATION_REFLECT]);

val HAS_BOUNDED_VARIATION_REFLECT_EQ_INTERVAL_AND_VECTOR_VARIATION_REFLECT_INTERVAL = store_thm ("HAS_BOUNDED_VARIATION_REFLECT_EQ_INTERVAL_AND_VECTOR_VARIATION_REFLECT_INTERVAL",
 ``(!f:real->real u v.
        (\x. f(-x)) has_bounded_variation_on interval[u,v] <=>
        f has_bounded_variation_on interval[-v,-u]) /\
   (!f:real->real u v.
        vector_variation (interval[u,v]) (\x. f(-x)) =
        vector_variation (interval[-v,-u]) f)``,
  SIMP_TAC std_ss [GSYM REFLECT_INTERVAL, HAS_BOUNDED_VARIATION_REFLECT_EQ,
              VECTOR_VARIATION_REFLECT]);

val HAS_BOUNDED_VARIATION_REFLECT_EQ_INTERVAL = store_thm ("HAS_BOUNDED_VARIATION_REFLECT_EQ_INTERVAL",
 ``(!f:real->real u v.
        (\x. f(-x)) has_bounded_variation_on interval[u,v] <=>
        f has_bounded_variation_on interval[-v,-u])``,
 REWRITE_TAC [HAS_BOUNDED_VARIATION_REFLECT_EQ_INTERVAL_AND_VECTOR_VARIATION_REFLECT_INTERVAL]);

val VECTOR_VARIATION_REFLECT_INTERVAL = store_thm ("VECTOR_VARIATION_REFLECT_INTERVAL",
 ``(!f:real->real u v.
        vector_variation (interval[u,v]) (\x. f(-x)) =
        vector_variation (interval[-v,-u]) f)``,
 REWRITE_TAC [HAS_BOUNDED_VARIATION_REFLECT_EQ_INTERVAL_AND_VECTOR_VARIATION_REFLECT_INTERVAL]);

val HAS_BOUNDED_VARIATION_DARBOUX = store_thm ("HAS_BOUNDED_VARIATION_DARBOUX",
 ``!f a b.
     f has_bounded_variation_on interval[a,b] <=>
     ?g h. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
                  ==> (g x) <= (g y)) /\
           (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
                  ==> (h x) <= (h y)) /\
           (!x. f x = g x - h x)``,
  REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
   [MAP_EVERY EXISTS_TAC
     [``\x:real. (vector_variation (interval[a,x]) (f:real->real))``,
      ``\x:real. (vector_variation (interval[a,x]) f) - f x``] THEN
    SIMP_TAC real_ss [REAL_ARITH ``a - (a - x):real = x``] THEN
    REPEAT STRIP_TAC THENL
     [MATCH_MP_TAC VECTOR_VARIATION_MONOTONE,
      MATCH_MP_TAC(REAL_ARITH
       ``!x. a - (b - x) <= c - (d - x) ==> a - b <= c - d:real``) THEN
      EXISTS_TAC ``(f(a:real)):real`` THEN
      SIMP_TAC std_ss [] THEN
      MATCH_MP_TAC VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE] THEN
    (CONJ_TAC THENL
       [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SIMP_RULE std_ss [IMP_CONJ]
         HAS_BOUNDED_VARIATION_ON_SUBSET)),
        ALL_TAC] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
      REWRITE_TAC[SUBSET_INTERVAL, GSYM INTERVAL_EQ_EMPTY] THEN
      ASM_REAL_ARITH_TAC),
    GEN_REWR_TAC LAND_CONV [GSYM ETA_AX] THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUB THEN
    CONJ_TAC THEN MATCH_MP_TAC INCREASING_BOUNDED_VARIATION THEN
    ASM_REWRITE_TAC[]]);

val HAS_BOUNDED_VARIATION_DARBOUX_STRICT = store_thm ("HAS_BOUNDED_VARIATION_DARBOUX_STRICT",
 ``!f a b.
     f has_bounded_variation_on interval[a,b] <=>
     ?g h. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x < y
                  ==> (g x) < (g y)) /\
           (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x < y
                  ==> (h x) < (h y)) /\
           (!x. f x = g x - h x)``,
  REPEAT GEN_TAC THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_DARBOUX] THEN
  EQ_TAC THEN SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [``g:real->real``, ``h:real->real``] THEN
  STRIP_TAC THENL
   [MAP_EVERY EXISTS_TAC [``\x:real. g x + x``, ``\x:real. h x + x``] THEN
    ASM_SIMP_TAC std_ss [REAL_ARITH ``(a + x) - (b + x):real = a - b``] THEN
    REPEAT STRIP_TAC THEN
    MATCH_MP_TAC REAL_LET_ADD2 THEN ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC std_ss [REAL_LT_IMP_LE],
    MAP_EVERY EXISTS_TAC [``g:real->real``, ``h:real->real``] THEN
    ASM_REWRITE_TAC[REAL_LE_LT] THEN ASM_MESON_TAC[]]);

val HAS_BOUNDED_VARIATION_COMPOSE_INCREASING = store_thm ("HAS_BOUNDED_VARIATION_COMPOSE_INCREASING",
 ``!f g:real->real a b.
        (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
               ==> (f x) <= (f y)) /\
        g has_bounded_variation_on interval[f a,f b]
        ==> (g o f) has_bounded_variation_on interval[a,b]``,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  ONCE_REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_COMPONENTWISE] THEN
  ASM_SIMP_TAC std_ss [HAS_BOUNDED_VARIATION_DARBOUX, LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [``h:real->real``, ``k:real->real``] THEN
  STRIP_TAC THEN
  MAP_EVERY EXISTS_TAC [``(h:real->real) o (f:real->real)``,
                        ``(k:real->real) o (f:real->real)``] THEN
  ASM_SIMP_TAC std_ss [o_THM] THEN
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  REPEAT STRIP_TAC THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN
  ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[IN_INTERVAL] THEN CONJ_TAC THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[IN_INTERVAL] THEN POP_ASSUM MP_TAC THEN
  POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);

val HAS_BOUNDED_VARIATION_ON_REFLECT = store_thm ("HAS_BOUNDED_VARIATION_ON_REFLECT",
 ``!f:real->real s.
        f has_bounded_variation_on IMAGE (\x. -x) s
        ==> (\x. f(-x)) has_bounded_variation_on s``,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[has_bounded_variation_on] THEN
  REWRITE_TAC[has_bounded_setvariation_on] THEN
  DISCH_THEN (X_CHOOSE_TAC ``B:real``) THEN EXISTS_TAC ``B:real`` THEN
  MAP_EVERY X_GEN_TAC [``d:(real->bool)->bool``, ``t:real->bool``] THEN
  STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
   [``IMAGE (IMAGE (\x. -x)) (d:(real->bool)->bool)``,
    ``IMAGE (\x. -x) (t:real->bool)``]) THEN
  ASM_SIMP_TAC std_ss [DIVISION_OF_REFLECT] THEN
  SIMP_TAC std_ss [SUBSET_DEF, FORALL_IN_IMAGE] THEN
  KNOW_TAC ``(!x:real. x IN t ==> -x IN IMAGE (\x. -x) s)`` THENL
  [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  ASM_REWRITE_TAC[GSYM SUBSET_DEF] THEN
  W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o lhand o lhand o snd) THEN
  KNOW_TAC ``(!(x :real -> bool) (y :real -> bool).
    x IN (d :(real -> bool) -> bool) /\ y IN d /\
    (IMAGE (\(x :real). -x) x = IMAGE (\(x :real). -x) y) ==>
    (x = y))`` THENL
   [METIS_TAC[REAL_ARITH ``(-x:real = -y) <=> (x = y)``, INJECTIVE_IMAGE],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    DISCH_THEN SUBST1_TAC THEN
    MATCH_MP_TAC(REAL_ARITH ``(x = y) ==> x <= d ==> y <= d:real``) THEN
    MATCH_MP_TAC SUM_EQ THEN UNDISCH_TAC ``d division_of t`` THEN
    DISCH_TAC THEN FIRST_ASSUM(fn th =>
      SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION th]) THEN
    MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN DISCH_TAC THEN
    SUBGOAL_THEN ``u <= v:real`` ASSUME_TAC THENL
     [METIS_TAC[GSYM INTERVAL_NE_EMPTY, division_of], ALL_TAC] THEN
    ASM_SIMP_TAC std_ss [o_THM, REFLECT_INTERVAL] THEN
    ASM_SIMP_TAC std_ss [INTERVAL_UPPERBOUND, INTERVAL_LOWERBOUND,
                 REAL_LE_NEG2] THEN
    REAL_ARITH_TAC]);

val HAS_BOUNDED_VARIATION_ON_REFLECT_INTERVAL = store_thm ("HAS_BOUNDED_VARIATION_ON_REFLECT_INTERVAL",
 ``!f:real->real a b.
        f has_bounded_variation_on interval[-b,-a]
        ==> (\x. f(-x)) has_bounded_variation_on interval[a,b]``,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_REFLECT THEN
  ASM_REWRITE_TAC[REFLECT_INTERVAL]);

val VECTOR_VARIATION_REFLECT_INTERVAL = store_thm ("VECTOR_VARIATION_REFLECT_INTERVAL",
 ``!f:real->real a b.
        vector_variation (interval[a,b]) (\x. f(-x)) =
        vector_variation (interval[-b,-a]) f``,
  REWRITE_TAC[VECTOR_VARIATION_REFLECT, REFLECT_INTERVAL]);

val HAS_BOUNDED_VARIATION_COMPOSE_DECREASING = store_thm ("HAS_BOUNDED_VARIATION_COMPOSE_DECREASING",
 ``!f g:real->real a b.
        (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
               ==> (f y) <= (f x)) /\
        g has_bounded_variation_on interval[f b,f a]
        ==> (g o f) has_bounded_variation_on interval[a,b]``,
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[REAL_NEG_NEG]
    (ISPECL [``f:real->real``, ``-b:real``, ``-a:real``]
        HAS_BOUNDED_VARIATION_ON_REFLECT_INTERVAL))) THEN
  POP_ASSUM MP_TAC THEN
  GEN_REWR_TAC (LAND_CONV o BINDER_CONV o BINDER_CONV o RAND_CONV)
   [GSYM REAL_LE_NEG2] THEN
  REWRITE_TAC[AND_IMP_INTRO] THEN
  ONCE_REWRITE_TAC [METIS [] ``-f x <= -f y <=> (\x. -f x) x <= (\y. -f y) y:real``] THEN
  ONCE_REWRITE_TAC [METIS [] ``interval [(-f a,-f b:real)] =
                               interval [((\x. -f x) a,(\x. -f x) b)]``] THEN
  DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_COMPOSE_INCREASING) THEN
  SIMP_TAC std_ss [o_DEF, REAL_NEG_NEG]);

val HAS_BOUNDED_VARIATION_ON_ID = store_thm ("HAS_BOUNDED_VARIATION_ON_ID",
 ``!a b. (\x. x) has_bounded_variation_on interval[a,b]``,
  REPEAT GEN_TAC THEN MATCH_MP_TAC INCREASING_BOUNDED_VARIATION THEN
  SIMP_TAC std_ss []);

val HAS_BOUNDED_VARIATION_ON_COMBINE_GEN = store_thm ("HAS_BOUNDED_VARIATION_ON_COMBINE_GEN",
 ``!f:real->real s a.
        is_interval s
        ==> (f has_bounded_variation_on s <=>
             f has_bounded_variation_on {x | x IN s /\ x <= a} /\
             f has_bounded_variation_on {x | x IN s /\ x >= a})``,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [DISCH_THEN(fn th => CONJ_TAC THEN MP_TAC th) THEN
    MATCH_MP_TAC(SIMP_RULE std_ss [IMP_CONJ_ALT]
      HAS_BOUNDED_VARIATION_ON_SUBSET) THEN
    SIMP_TAC std_ss [SUBSET_RESTRICT],
    ALL_TAC] THEN
  DISCH_TAC THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_NONTRIVIAL] THEN
  SUBGOAL_THEN ``bounded(IMAGE (f:real->real) s)`` MP_TAC THENL
   [MATCH_MP_TAC BOUNDED_SUBSET THEN
    EXISTS_TAC
     ``IMAGE (f:real->real)
            ({x | x IN s /\ x <= a} UNION
             {x | x IN s /\ x >= a})`` THEN
    CONJ_TAC THENL
     [REWRITE_TAC[IMAGE_UNION, BOUNDED_UNION] THEN CONJ_TAC THEN
      MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED THEN
      ASM_REWRITE_TAC[] THEN
      ONCE_REWRITE_TAC [METIS [] ``(x <= a <=> (\x. x <= a) x) /\
                                   (x >= a <=> (\x. x >= a) x)``] THEN
      REWRITE_TAC[SET_RULE ``{x | x IN s /\ P x} = s INTER {x | P x}``] THEN
      MATCH_MP_TAC IS_INTERVAL_INTER THEN ASM_REWRITE_TAC[] THEN
      SIMP_TAC std_ss [IS_INTERVAL_CASES, real_ge] THEN METIS_TAC[],
      MATCH_MP_TAC IMAGE_SUBSET THEN
      SIMP_TAC std_ss [SUBSET_DEF, GSPECIFICATION, IN_UNION] THEN REAL_ARITH_TAC],
    SIMP_TAC std_ss [BOUNDED_POS, FORALL_IN_IMAGE] THEN
    DISCH_THEN(X_CHOOSE_THEN ``D:real`` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(CONJUNCTS_THEN MP_TAC) THEN
    REWRITE_TAC[has_bounded_variation_on, has_bounded_setvariation_on] THEN
    SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC ``C:real`` THEN DISCH_TAC THEN
    X_GEN_TAC ``B:real`` THEN DISCH_TAC] THEN
  EXISTS_TAC ``&4 * D + B + C:real`` THEN
  MAP_EVERY X_GEN_TAC [``d:(real->bool)->bool``, ``t:real->bool``] THEN
  STRIP_TAC THEN
  ABBREV_TAC ``dl = {k:real->bool |
                    k IN d /\ k SUBSET {x | x IN s /\ x <= a}}`` THEN
  ABBREV_TAC ``dr = {k:real->bool |
                    k IN d /\ k SUBSET {x | x IN s /\ x >= a}}`` THEN
  UNDISCH_TAC ``!d t.
        d division_of t /\ t SUBSET {x | x IN s /\ x >= a} ==>
        sum d (\k. abs
               (f (interval_upperbound k) -
                f (interval_lowerbound k))) <= C`` THEN DISCH_TAC THEN
  FIRST_X_ASSUM (MP_TAC o SPECL
   [``dr:(real->bool)->bool``, ``BIGUNION dr:real->bool``]) THEN
  FIRST_X_ASSUM (MP_TAC o SPECL
   [``dl:(real->bool)->bool``, ``BIGUNION dl:real->bool``]) THEN
  KNOW_TAC ``dl division_of BIGUNION dl:real->bool /\
    BIGUNION dl SUBSET {x | x IN s /\ x <= a}`` THENL
   [CONJ_TAC THENL [MATCH_MP_TAC DIVISION_OF_SUBSET, ASM_SET_TAC[]] THEN
    EXISTS_TAC ``d:(real->bool)->bool`` THEN
    CONJ_TAC THENL [METIS_TAC[DIVISION_OF_UNION_SELF], ASM_SET_TAC[]],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`]] THEN
  KNOW_TAC ``dr division_of BIGUNION dr:real->bool /\
    BIGUNION dr SUBSET {x | x IN s /\ x >= a}`` THENL
  [CONJ_TAC THENL [MATCH_MP_TAC DIVISION_OF_SUBSET, ASM_SET_TAC[]] THEN
    EXISTS_TAC ``d:(real->bool)->bool`` THEN
    CONJ_TAC THENL [METIS_TAC[DIVISION_OF_UNION_SELF], ASM_SET_TAC[]],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`]] THEN
  UNDISCH_TAC ``d division_of t`` THEN DISCH_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
  MATCH_MP_TAC(REAL_ARITH
   ``u <= (s + t) + d ==> s <= b ==> t <= c ==> u <= d + b + c:real``) THEN
  W(MP_TAC o PART_MATCH (rand o rand)
    SUM_UNION_NONZERO o lhand o rand o snd) THEN
  KNOW_TAC ``FINITE (dl :(real -> bool) -> bool) /\
             FINITE (dr :(real -> bool) -> bool) /\
   (!(x :real -> bool). x IN dl INTER dr ==>
    ((\(k :real -> bool).
        abs ((f :real -> real) (interval_upperbound k) -
           f (interval_lowerbound k))) x = (0 : real)))`` THENL
   [MAP_EVERY EXPAND_TAC ["dl", "dr"] THEN
    SIMP_TAC std_ss [IN_INTER, GSPECIFICATION] THEN
    ASM_SIMP_TAC std_ss [FINITE_RESTRICT, IMP_CONJ] THEN
    UNDISCH_TAC ``d division_of t`` THEN DISCH_TAC THEN
    FIRST_ASSUM(fn th =>
     SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN
    SIMP_TAC std_ss [INTERVAL_LOWERBOUND_NONEMPTY, INTERVAL_UPPERBOUND_NONEMPTY] THEN
    REWRITE_TAC[AND_IMP_INTRO, GSYM SUBSET_INTER, GSYM CONJ_ASSOC] THEN
    ONCE_REWRITE_TAC [METIS [] ``(x <= a <=> (\x. x <= a) x) /\
                                 (x >= a <=> (\x. x >= a) x)``] THEN
    REWRITE_TAC [SET_RULE
     ``{x | x IN P /\ Q x} INTER {x | x IN P /\ R x} = {x | x IN P /\ Q x /\ R x}``] THEN
    SIMP_TAC std_ss [REAL_ARITH ``x <= a /\ x >= a <=> (x = a:real)``] THEN
    REPEAT STRIP_TAC THEN REWRITE_TAC[ABS_ZERO, REAL_SUB_0] THEN AP_TERM_TAC THEN
    FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
     ``s SUBSET {x | x IN t /\ (x = a)} ==> s SUBSET {a}``)) THEN
    REWRITE_TAC[GSYM INTERVAL_SING, SUBSET_INTERVAL] THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [INTERVAL_NE_EMPTY]) THEN
    REAL_ARITH_TAC,
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    DISCH_THEN(SUBST1_TAC o SYM)] THEN
  MATCH_MP_TAC(REAL_ARITH ``s - t <= b ==> s <= t + b:real``) THEN
  W(MP_TAC o PART_MATCH (rand o rand) SUM_DIFF o lhand o snd) THEN
  ASM_SIMP_TAC std_ss [] THEN
  KNOW_TAC ``dl UNION (dr:(real->bool)->bool) SUBSET d`` THENL
  [ASM_SET_TAC[], DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
   POP_ASSUM K_TAC THEN DISCH_THEN(SUBST1_TAC o SYM)] THEN
  SUBGOAL_THEN
   ``FINITE(d DIFF (dl UNION dr):(real->bool)->bool) /\
     CARD(d DIFF (dl UNION dr)) <= 2``
  STRIP_ASSUME_TAC THENL
   [MATCH_MP_TAC(METIS[CARD_SUBSET, LESS_EQ_TRANS, FINITE_SUBSET]
     ``!t. s SUBSET t /\ FINITE t /\ CARD t <= 2
          ==> FINITE s /\ CARD s <= 2``) THEN
    EXISTS_TAC ``{k | k IN d /\ ~(content k = &0) /\ a IN k}`` THEN
    ASM_SIMP_TAC std_ss [FINITE_RESTRICT] THEN
    SUBST1_TAC(MESON[EXP_1] ``2 = 2 EXP 1``) THEN
    CONJ_TAC THENL
     [ALL_TAC,
      MATCH_MP_TAC DIVISION_COMMON_POINT_BOUND THEN ASM_MESON_TAC[]] THEN
    GEN_REWR_TAC I [SUBSET_DEF] THEN MAP_EVERY EXPAND_TAC ["dl", "dr"] THEN
    SIMP_TAC std_ss [IN_DIFF, IMP_CONJ, GSPECIFICATION, IN_UNION] THEN
    UNDISCH_TAC ``d division_of t`` THEN DISCH_TAC THEN
    FIRST_ASSUM(fn th =>
      SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN
    SIMP_TAC std_ss [INTERVAL_LOWERBOUND_NONEMPTY, INTERVAL_UPPERBOUND_NONEMPTY] THEN
    ONCE_REWRITE_TAC [METIS [] ``(x <= a <=> (\x. x <= a) x) /\
                                 (x >= a <=> (\x. x >= a) x)``] THEN
    REWRITE_TAC[SET_RULE ``{x | x IN s /\ P x} = s INTER {x | P x}``] THEN
    MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN STRIP_TAC THEN
    SUBGOAL_THEN ``interval[u:real,v] SUBSET s`` ASSUME_TAC THENL
     [METIS_TAC[division_of, SUBSET_DEF], ASM_REWRITE_TAC[SUBSET_INTER]] THEN
    SIMP_TAC std_ss [CONTENT_EQ_0, IN_INTERVAL, SUBSET_DEF, GSPECIFICATION] THEN
    REAL_ARITH_TAC,
    ALL_TAC] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
   ``&(CARD(d DIFF (dl UNION dr):(real->bool)->bool)) * &2 * D:real`` THEN
  CONJ_TAC THENL
   [REWRITE_TAC [GSYM REAL_MUL_ASSOC] THEN
    MATCH_MP_TAC SUM_BOUND THEN ASM_SIMP_TAC std_ss [] THEN
    REWRITE_TAC[IN_DIFF, IMP_CONJ] THEN UNDISCH_TAC ``d division_of t`` THEN
    DISCH_TAC THEN FIRST_ASSUM(fn th =>
      SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN
    SIMP_TAC std_ss [INTERVAL_LOWERBOUND_NONEMPTY, INTERVAL_UPPERBOUND_NONEMPTY] THEN
    REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
     ``abs(x:real) <= d /\ abs y <= d ==> abs(x - y) <= &2 * d:real``) THEN
    ASM_MESON_TAC[division_of, SUBSET_DEF, ENDS_IN_INTERVAL],
    ASM_SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_LE_RMUL] THEN
    REWRITE_TAC[REAL_ARITH ``x * &2 <= &4 <=> x <= &2:real``] THEN
    ASM_REWRITE_TAC[REAL_OF_NUM_LE]]);

val HAS_BOUNDED_VARIATION_ON_CLOSURE = store_thm ("HAS_BOUNDED_VARIATION_ON_CLOSURE",
 ``!f:real->real s.
        is_interval s /\ f has_bounded_variation_on s
        ==> f has_bounded_variation_on (closure s)``,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP CARD_FRONTIER_INTERVAL) THEN
  SUBGOAL_THEN ``bounded (IMAGE (f:real->real) (closure (s:real->bool)))`` MP_TAC THENL
   [MATCH_MP_TAC BOUNDED_SUBSET THEN
    EXISTS_TAC ``IMAGE (f:real->real) (s UNION frontier s)`` THEN
    CONJ_TAC THENL
     [ASM_REWRITE_TAC[IMAGE_UNION, BOUNDED_UNION] THEN
      ASM_SIMP_TAC std_ss [HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED] THEN
      ASM_SIMP_TAC std_ss [FINITE_IMP_BOUNDED, IMAGE_FINITE],
      REWRITE_TAC[frontier] THEN
      MP_TAC(ISPEC ``s:real->bool`` INTERIOR_SUBSET) THEN SET_TAC[]],
    SIMP_TAC std_ss [BOUNDED_POS, FORALL_IN_IMAGE] THEN
    DISCH_THEN(X_CHOOSE_THEN ``B:real`` STRIP_ASSUME_TAC) THEN
    UNDISCH_TAC ``(f:real->real) has_bounded_variation_on s`` THEN
    REWRITE_TAC[has_bounded_setvariation_on, has_bounded_variation_on] THEN
    DISCH_THEN(X_CHOOSE_THEN ``kk:real`` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC ``kk + &8 * B:real`` THEN
    MAP_EVERY X_GEN_TAC [``d:(real->bool)->bool``, ``u:real->bool``] THEN
    STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
    SUBGOAL_THEN
     ``d = { k:real->bool |
            k IN d /\ k SUBSET s} UNION {k | k IN d /\ ~(k SUBSET s)}``
    SUBST1_TAC THENL [SET_TAC[], ALL_TAC] THEN
    KNOW_TAC ``sum {k | k IN d /\ k SUBSET s}
       (\k. abs (f (interval_upperbound k) - f (interval_lowerbound k))) +
            sum {k | k IN d /\ ~(k SUBSET s)}
       (\k. abs (f (interval_upperbound k) - f (interval_lowerbound k))) <=
            kk + &8 * B:real /\
         FINITE {k | k IN d /\ k SUBSET s} /\
         FINITE {k | k IN d /\ ~(k SUBSET s)} /\
         DISJOINT {k | k IN d /\ k SUBSET s} {k | k IN d /\ ~(k SUBSET s)}`` THENL
    [ALL_TAC, METIS_TAC [SUM_UNION]] THEN ASM_SIMP_TAC std_ss [FINITE_RESTRICT] THEN
    CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_ADD2, SET_TAC[]] THEN CONJ_TAC THENL
     [FULL_SIMP_TAC std_ss [] THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN
      EXISTS_TAC ``BIGUNION {k:real->bool | k IN d /\ k SUBSET s}`` THEN
      CONJ_TAC THENL [MATCH_MP_TAC DIVISION_OF_SUBSET, SET_TAC[]] THEN
      EXISTS_TAC ``d:(real->bool)->bool`` THEN
      CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_UNION_SELF], SET_TAC[]],
      ONCE_REWRITE_TAC[GSYM SUM_SUPPORT] THEN
      SIMP_TAC std_ss [support, GSPECIFICATION, NEUTRAL_REAL_ADD] THEN
      REWRITE_TAC[ABS_ZERO, REAL_SUB_0] THEN
      MP_TAC(ISPECL
       [``{k | (k IN d /\ ~(k SUBSET s)) /\
              ~((f:real->real)(interval_upperbound k) =
                f (interval_lowerbound k))}``,
        ``\k. abs ((f:real->real) (interval_upperbound k) -
                    f (interval_lowerbound k))``,
        ``&2 * B:real``] SUM_BOUND) THEN
      ASM_SIMP_TAC std_ss [GSYM CONJ_ASSOC, FINITE_RESTRICT, FORALL_IN_GSPEC] THEN
      KNOW_TAC ``(!(k :real -> bool).
         k IN (d :(real -> bool) -> bool) /\ ~(k SUBSET (s :real -> bool)) /\
        (f :real -> real) (interval_upperbound k) <>
         f (interval_lowerbound k) ==>
        abs (f (interval_upperbound k) - f (interval_lowerbound k)) <=
        (2 :real) * (B :real))`` THENL
       [ONCE_REWRITE_TAC[IMP_CONJ] THEN UNDISCH_TAC ``d division_of u`` THEN
        DISCH_TAC THEN FIRST_ASSUM(fn th =>
          SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN
        SIMP_TAC std_ss [INTERVAL_LOWERBOUND_NONEMPTY,
                 INTERVAL_UPPERBOUND_NONEMPTY] THEN
        MAP_EVERY X_GEN_TAC [``a:real``, ``b:real``] THEN STRIP_TAC THEN
        STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
         ``abs(x) <= B /\ abs(y) <= B ==> abs(y - x:real) <= &2 * B``) THEN
        CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
        UNDISCH_TAC ``d division_of u`` THEN DISCH_TAC THEN
        FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [division_of]) THEN
        DISCH_THEN (CONJUNCTS_THEN2 K_TAC MP_TAC) THEN
        DISCH_THEN (CONJUNCTS_THEN2 MP_TAC K_TAC) THEN
        DISCH_THEN(MP_TAC o SPEC ``interval[a:real,b]``) THEN
        ASM_REWRITE_TAC[] THENL
        [ONCE_REWRITE_TAC [METIS []
         ``(?a' b'. interval [(a,b)] = interval [(a',b')]) =
           (\a. (?a' b'. interval [(a,b)] = interval [(a',b')])) a``],
         ONCE_REWRITE_TAC [METIS []
         ``(?a' b'. interval [(a,b)] = interval [(a',b')]) =
           (\b. (?a' b'. interval [(a,b)] = interval [(a',b')])) b``]]  THEN
        MATCH_MP_TAC(SET_RULE
         ``u SUBSET s /\ x IN i ==> i SUBSET u /\ P x ==> x IN s``) THEN
        ASM_REWRITE_TAC[ENDS_IN_INTERVAL],
        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
        MATCH_MP_TAC(SIMP_RULE std_ss [IMP_CONJ_ALT] REAL_LE_TRANS) THEN
        ASM_SIMP_TAC std_ss [REAL_MUL_ASSOC, REAL_LE_RMUL] THEN
        REWRITE_TAC[REAL_ARITH ``x * &2 <= &8 <=> x <= &4:real``] THEN
        REWRITE_TAC[REAL_OF_NUM_LE] THEN
        MATCH_MP_TAC LESS_EQ_TRANS THEN EXISTS_TAC
         ``CARD(BIGUNION {{k | k IN d /\ ~(content k = &0) /\ x IN k}
                       | (x:real) IN frontier s})`` THEN
        CONJ_TAC THENL
         [MATCH_MP_TAC (SIMP_RULE std_ss [AND_IMP_INTRO,
                        GSYM RIGHT_FORALL_IMP_THM] CARD_SUBSET) THEN
          CONJ_TAC THENL
          [MATCH_MP_TAC FINITE_BIGUNION THEN
           ASM_SIMP_TAC std_ss [FORALL_IN_GSPEC, FINITE_RESTRICT] THEN
           ASM_SIMP_TAC real_ss [IMAGE_FINITE, GSYM IMAGE_DEF, BIGUNION_IMAGE],
           ALL_TAC] THEN
          ASM_SIMP_TAC std_ss [FORALL_IN_GSPEC, FINITE_RESTRICT] THEN
          ASM_SIMP_TAC real_ss [IMAGE_FINITE, GSYM IMAGE_DEF, BIGUNION_IMAGE] THEN
          GEN_REWR_TAC I [SUBSET_DEF] THEN SIMP_TAC std_ss [GSPECIFICATION] THEN
          ONCE_REWRITE_TAC[IMP_CONJ] THEN UNDISCH_TAC ``d division_of u`` THEN
          DISCH_TAC THEN FIRST_ASSUM(fn th =>
            SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN
          SIMP_TAC std_ss [INTERVAL_LOWERBOUND_NONEMPTY,
                 INTERVAL_UPPERBOUND_NONEMPTY] THEN
          SIMP_TAC std_ss [INTERVAL_NE_EMPTY, CONTENT_CLOSED_INTERVAL, REAL_SUB_0] THEN
          REPEAT STRIP_TAC THEN
          FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
           ``~(s SUBSET t) ==> s SUBSET closure t
                ==> ?x. x IN (closure t DIFF t) /\ x IN s``)) THEN
          KNOW_TAC ``interval [(a,b:real)] SUBSET closure s`` THENL
          [ASM_MESON_TAC[division_of, SUBSET_DEF],
           DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
          REWRITE_TAC[frontier] THEN
          MP_TAC(ISPEC ``s:real->bool`` INTERIOR_SUBSET) THEN ASM_SET_TAC[],
          MATCH_MP_TAC LESS_EQ_TRANS THEN EXISTS_TAC ``CARD(frontier s:real->bool) * 2`` THEN
          CONJ_TAC THENL [ALL_TAC, ASM_SIMP_TAC arith_ss []] THEN
          ONCE_REWRITE_TAC [METIS []
           ``{k | k IN d /\ content k <> 0 /\ x IN k} =
             (\x. {k | k IN d /\ content k <> 0 /\ x IN k}) x``] THEN
          MATCH_MP_TAC CARD_BIGUNION_LE THEN
          ASM_SIMP_TAC std_ss [GSYM FINITE_HAS_SIZE, FINITE_RESTRICT] THEN
          SUBST1_TAC(METIS [EXP_1] ``(2:num) = 2 EXP 1``) THEN
          REPEAT STRIP_TAC THEN SIMP_TAC std_ss [] THEN
          SUBST1_TAC(METIS [EXP_1] ``(2:num) = 2 EXP 1``) THEN
          MATCH_MP_TAC DIVISION_COMMON_POINT_BOUND THEN METIS_TAC[]]]]]);

val HAS_BOUNDED_VARIATION_ON_SING = store_thm ("HAS_BOUNDED_VARIATION_ON_SING",
 ``!f a. f has_bounded_variation_on {a}``,
  REWRITE_TAC[has_bounded_variation_on, has_bounded_setvariation_on,
              REWRITE_RULE[INTERVAL_SING] DIVISION_OF_SING] THEN
  REPEAT GEN_TAC THEN EXISTS_TAC ``&0:real`` THEN
  MAP_EVERY X_GEN_TAC [``d:(real->bool)->bool``, ``t:real->bool``] THEN
  STRIP_TAC THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ_0 THEN
  FIRST_ASSUM(fn th =>
    SIMP_TAC std_ss [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN
  SIMP_TAC std_ss [INTERVAL_LOWERBOUND_NONEMPTY, INTERVAL_UPPERBOUND_NONEMPTY] THEN
  MAP_EVERY X_GEN_TAC [``u:real``, ``v:real``] THEN STRIP_TAC THEN
  REWRITE_TAC[ABS_ZERO, REAL_SUB_0] THEN AP_TERM_TAC THEN
  SUBGOAL_THEN ``interval[u:real,v] SUBSET interval[a,a]`` MP_TAC THENL
   [REWRITE_TAC[INTERVAL_SING] THEN ASM_MESON_TAC[division_of, SUBSET_DEF],
    REWRITE_TAC[SUBSET_INTERVAL] THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [INTERVAL_NE_EMPTY]) THEN
    REAL_ARITH_TAC]);

val INCREASING_LEFT_LIMIT = store_thm ("INCREASING_LEFT_LIMIT",
 ``!f a b c.
        (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
               ==> (f x) <= (f y)) /\
        c IN interval[a,b]
       ==> ?l. (f --> l) (at c within interval[a,c])``,
  REPEAT STRIP_TAC THEN EXISTS_TAC
   ``(sup {(f x) | x IN interval[a,b] /\ x < c})`` THEN
  ONCE_REWRITE_TAC [METIS [] ``{f x | x IN interval [(a,b)] /\ x < c} =
                          {f x | (\x. x IN interval [(a,b)] /\ x < c) x}``] THEN
  ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC std_ss [LIM_WITHIN] THEN
  REWRITE_TAC[dist] THEN
  ASM_CASES_TAC ``{x | x IN interval[a,b] /\ x < c} = {}`` THENL
   [GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC ``&1:real`` THEN
    REWRITE_TAC[REAL_LT_01] THEN
    UNDISCH_TAC ``{x:real | x IN interval [(a,b)] /\ x < c} = {}`` THEN
    DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [EXTENSION]) THEN
    DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o SPEC ``x:real``) THEN
    MATCH_MP_TAC(TAUT `(a ==> ~b) ==> a ==> b ==> c`) THEN
    SIMP_TAC std_ss [NOT_IN_EMPTY, GSPECIFICATION, IN_INTERVAL] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN POP_ASSUM MP_TAC THEN
    POP_ASSUM MP_TAC THEN REAL_ARITH_TAC,
    ALL_TAC] THEN
  X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
  MP_TAC(ISPEC ``{((f:real->real) x) | x IN interval[a,b] /\ x < c}`` SUP) THEN
  ASM_SIMP_TAC std_ss [FORALL_IN_GSPEC] THEN
  KNOW_TAC ``{(f:real->real) x | x IN interval [(a,b)] /\ x < c} <> {} /\
             (?b'. !x. x IN interval [(a,b)] /\ x < c ==> f x <= b')`` THENL
   [CONJ_TAC THENL
     [ONCE_REWRITE_TAC [METIS [] ``{f x | x IN interval [(a,b)] /\ x < c} =
                          {f x | (\x. x IN interval [(a,b)] /\ x < c) x}``] THEN
      ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN ASM_SIMP_TAC std_ss [IMAGE_EQ_EMPTY],
      EXISTS_TAC ``(f(b:real)):real`` THEN REPEAT STRIP_TAC THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_REAL_ARITH_TAC],
    DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
    ONCE_REWRITE_TAC [METIS [] ``{f x | x IN interval [(a,b)] /\ x < c} =
                          {f x | (\x. x IN interval [(a,b)] /\ x < c) x}``] THEN
    ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN SIMP_TAC std_ss [IMAGE_ID] THEN
    ABBREV_TAC ``s = sup (IMAGE (\x. (f x))
                        {x | x IN interval[a,b] /\ x < c})`` THEN
    ASM_SIMP_TAC std_ss [] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC ``s - e:real``)) THEN
    FULL_SIMP_TAC std_ss [METIS [ETA_AX] ``(\x. f x) = f:real->real``] THEN
    ASM_SIMP_TAC std_ss [REAL_ARITH ``&0 < e ==> ~(s <= s - e:real)``, NOT_FORALL_THM] THEN
    SIMP_TAC std_ss [NOT_IMP, REAL_NOT_LE, IN_INTERVAL] THEN
    DISCH_THEN(X_CHOOSE_THEN ``d:real`` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC ``c - d:real`` THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
    CONJ_TAC THENL [POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
                    REAL_ARITH_TAC, ALL_TAC] THEN
    X_GEN_TAC ``x:real`` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [``d:real``, ``x:real``]) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN ASM_REAL_ARITH_TAC]);

val DECREASING_LEFT_LIMIT = store_thm ("DECREASING_LEFT_LIMIT",
 ``!f a b c.
        (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
               ==> (f y) <= (f x)) /\
        c IN interval[a,b]
        ==> ?l. (f --> l) (at c within interval[a,c])``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL
   [``\x. -((f:real->real) x)``, ``a:real``, ``b:real``, ``c:real``]
        INCREASING_LEFT_LIMIT) THEN
  ASM_SIMP_TAC std_ss [REAL_LE_NEG2] THEN
  GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM LIM_NEG_EQ] THEN
  SIMP_TAC std_ss [REAL_NEG_NEG, ETA_AX] THEN MESON_TAC[]);

val INCREASING_RIGHT_LIMIT = store_thm ("INCREASING_RIGHT_LIMIT",
 ``!f a b c.
        (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
               ==> (f x) <= (f y)) /\
        c IN interval[a,b]
       ==> ?l. (f --> l) (at c within interval[c,b])``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [``\x. (f:real->real) (-x)``,
                 ``-b:real``, ``-a:real``, ``-c:real``]
        DECREASING_LEFT_LIMIT) THEN
  ASM_SIMP_TAC std_ss [IN_INTERVAL_REFLECT] THEN
  ONCE_REWRITE_TAC [METIS []
    ``((!x y.
    x IN interval [(-b,-a)] /\ y IN interval [(-b,-a)] /\ x <= y ==>
    f (-y) <= (f:real->real) (-x))) =
      (!x y. (\x y.
    x IN interval [(-b,-a)] /\ y IN interval [(-b,-a)] /\ x <= y ==>
    f (-y) <= f (-x)) x y)``] THEN
  ONCE_REWRITE_TAC[METIS [REAL_NEG_NEG]
   ``(!x:real y:real. P x y) <=> (!x y. P (-x) (-y))``] THEN
  SIMP_TAC std_ss [IN_INTERVAL_REFLECT, REAL_NEG_NEG] THEN
  ASM_SIMP_TAC std_ss [REAL_LE_NEG2] THEN
  DISCH_THEN (X_CHOOSE_TAC ``l:real``) THEN EXISTS_TAC ``l:real`` THEN
  POP_ASSUM MP_TAC THEN SIMP_TAC std_ss [LIM_WITHIN] THEN
  ONCE_REWRITE_TAC [METIS []
   ``(!x.
       x IN interval [(-b,-c)] /\ 0 < dist (x,-c) /\ dist (x,-c) < d ==>
       dist (f (-x),l) < e) =
     (!x.
       (\x. x IN interval [(-b,-c)] /\ 0 < dist (x,-c) /\ dist (x,-c) < d ==>
       dist (f (-x),l) < e) x)``] THEN
  GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV)
   [MESON[REAL_NEG_NEG] ``(!x:real. P x) <=> (!x. P (-x))``] THEN
  SIMP_TAC std_ss [IN_INTERVAL_REFLECT, REAL_NEG_NEG, dist,
              REAL_ARITH ``abs(-x:real - -y) = abs(x - y)``]);

val DECREASING_RIGHT_LIMIT = store_thm ("DECREASING_RIGHT_LIMIT",
 ``!f a b c.
        (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ x <= y
               ==> (f y) <= (f x)) /\
        c IN interval[a,b]
       ==> ?l. (f --> l) (at c within interval[c,b])``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL
   [``\x. -((f:real->real) x)``, ``a:real``, ``b:real``, ``c:real``]
        INCREASING_RIGHT_LIMIT) THEN
  ASM_SIMP_TAC std_ss [REAL_LE_NEG2] THEN
  GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM LIM_NEG_EQ] THEN
  SIMP_TAC std_ss [REAL_NEG_NEG, ETA_AX] THEN MESON_TAC[]);

val HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT = store_thm ("HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT",
 ``!f:real->real a b c.
        f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b]
        ==> ?l. (f --> l) (at c within interval[a,c])``,
  REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  DISCH_THEN
   (MP_TAC o REWRITE_RULE [HAS_BOUNDED_VARIATION_DARBOUX]) THEN
  SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM, CONJ_ASSOC] THEN REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  REWRITE_TAC[GSYM CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN
   (MP_TAC o SPEC ``c:real`` o MATCH_MP
     (ONCE_REWRITE_RULE[IMP_CONJ] INCREASING_LEFT_LIMIT))) THEN
  ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC ``l2:real`` THEN DISCH_TAC THEN
  X_GEN_TAC ``l1:real`` THEN DISCH_TAC THEN
  EXISTS_TAC ``l1 - l2:real`` THEN
  GEN_REWR_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN
  ASM_SIMP_TAC std_ss [LIM_SUB]);

val HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT = store_thm ("HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT",
 ``!f:real->real a b c.
        f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b]
        ==> ?l. (f --> l) (at c within interval[c,b])``,
  REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  DISCH_THEN
   (MP_TAC o REWRITE_RULE [HAS_BOUNDED_VARIATION_DARBOUX]) THEN
  SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM, CONJ_ASSOC] THEN REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  REWRITE_TAC[GSYM CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN
   (MP_TAC o SPEC ``c:real`` o MATCH_MP
     (ONCE_REWRITE_RULE[IMP_CONJ] INCREASING_RIGHT_LIMIT))) THEN
  ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC ``l2:real`` THEN DISCH_TAC THEN
  X_GEN_TAC ``l1:real`` THEN DISCH_TAC THEN
  EXISTS_TAC ``l1 - l2:real`` THEN
  GEN_REWR_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN
  ASM_SIMP_TAC std_ss [LIM_SUB]);

val lemma = prove (
   ``!f:real->real a b c.
          f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b]
          ==> ((\x. (vector_variation(interval[a,x]) f))
               continuous (at c within interval[a,c]) <=>
              f continuous (at c within interval[a,c]))``,
    REPEAT STRIP_TAC THEN EQ_TAC THENL
     [REWRITE_TAC[continuous_within] THEN
      SIMP_TAC std_ss [GSPECIFICATION, dist] THEN
      DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC ``e:real``) THEN ASM_REWRITE_TAC[] THEN
      DISCH_THEN (X_CHOOSE_TAC ``d:real``) THEN EXISTS_TAC ``d:real`` THEN
      POP_ASSUM MP_TAC THEN STRIP_TAC THEN
      ASM_REWRITE_TAC[] THEN X_GEN_TAC ``x:real`` THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN
      MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``c:real``, ``x:real``]
          VECTOR_VARIATION_COMBINE) THEN
      KNOW_TAC ``a <= x /\ x <= c /\
                 (f:real->real) has_bounded_variation_on interval [(a,c)]`` THENL
       [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
        REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC, ALL_TAC]) THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
           HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN
        REWRITE_TAC[SUBSET_INTERVAL] THEN ASM_REAL_ARITH_TAC,
        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
      DISCH_THEN(SUBST1_TAC o SYM) THEN
      REWRITE_TAC[REAL_ARITH ``abs(a - (a + b)) = abs b:real``] THEN
      MATCH_MP_TAC(REAL_ARITH ``x <= a ==> x <= abs a:real``) THEN
      ONCE_REWRITE_TAC[ABS_SUB] THEN
      MATCH_MP_TAC VECTOR_VARIATION_GE_ABS_FUNCTION THEN CONJ_TAC THENL
       [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          HAS_BOUNDED_VARIATION_ON_SUBSET)),
        REWRITE_TAC[SEGMENT] THEN COND_CASES_TAC] THEN
      REWRITE_TAC[SUBSET_INTERVAL] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_REAL_ARITH_TAC,
      ALL_TAC] THEN
    DISCH_TAC THEN ASM_CASES_TAC ``c limit_point_of interval[a:real,c]`` THENL
     [ALL_TAC,
      ASM_REWRITE_TAC[CONTINUOUS_WITHIN, LIM, TRIVIAL_LIMIT_WITHIN]] THEN
    UNDISCH_TAC ``f has_bounded_variation_on interval [(a,b)]`` THEN
    DISCH_TAC THEN FIRST_ASSUM(MP_TAC o
      REWRITE_RULE [HAS_BOUNDED_VARIATION_DARBOUX]) THEN
    SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [``g:real->real``, ``h:real->real``] THEN
    STRIP_TAC THEN
    MP_TAC(ISPECL [``h:real->real``, ``a:real``, ``b:real``, ``c:real``]
     INCREASING_LEFT_LIMIT) THEN
    MP_TAC(ISPECL [``g:real->real``, ``a:real``, ``b:real``, ``c:real``]
     INCREASING_LEFT_LIMIT) THEN
    ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC ``gc:real`` THEN DISCH_TAC THEN
    X_GEN_TAC ``hc:real`` THEN DISCH_TAC THEN
    ABBREV_TAC ``k = gc - (g:real->real) c`` THEN
    SUBGOAL_THEN ``hc - (h:real->real) c = k`` ASSUME_TAC THENL
     [EXPAND_TAC "k" THEN
      ONCE_REWRITE_TAC[REAL_ARITH
       ``(hc' - hc:real = gc' - gc) <=> (gc' - hc' = gc - hc)``] THEN
      UNDISCH_TAC ``f continuous (at c within interval [(a,c)])`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [CONTINUOUS_WITHIN]) THEN
      ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`]
        LIM_UNIQUE) THEN
      ASM_REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN
      GEN_REWR_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN
      ASM_SIMP_TAC std_ss [LIM_SUB],
      ALL_TAC] THEN
    MAP_EVERY ABBREV_TAC
     [``g':real->real = \x. if c <= x then g(x) + k else g(x)``,
      ``h':real->real =
           \x. if c <= x then h(x) + k else h(x)``] THEN
    SUBGOAL_THEN
     ``(!x y. x IN interval[a,c] /\ y IN interval[a,c] /\ x <= y
             ==> (g' x) <= ((g':real->real) y)) /\
      (!x y. x IN interval[a,c] /\ y IN interval[a,c] /\ x <= y
             ==> (h' x) <= ((h':real->real) y))``
    STRIP_ASSUME_TAC THENL
     [MAP_EVERY EXPAND_TAC ["g'", "h'"] THEN SIMP_TAC std_ss [] THEN CONJ_TAC THEN
      MAP_EVERY X_GEN_TAC [``x:real``, ``y:real``] THEN
      REWRITE_TAC[IN_INTERVAL] THEN STRIP_TAC THEN
      (ASM_CASES_TAC ``c <= x:real`` THENL
        [SUBGOAL_THEN ``c <= y:real`` ASSUME_TAC THENL
          [POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
           UNDISCH_TAC ``x <= c:real`` THEN REAL_ARITH_TAC,
           ASM_SIMP_TAC std_ss []] THEN
         REWRITE_TAC[REAL_LE_RADD] THEN
         FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN
         RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
         UNDISCH_TAC `` a <= c /\ c <= b:real`` THEN
         POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
         POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
         POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
         POP_ASSUM MP_TAC THEN REAL_ARITH_TAC,
         ALL_TAC] THEN
       ASM_SIMP_TAC std_ss [] THEN COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [] THENL
        [ALL_TAC,
         FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN
         RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
         UNDISCH_TAC `` a <= c /\ c <= b:real`` THEN
         POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
         POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
         POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
         POP_ASSUM MP_TAC THEN REAL_ARITH_TAC] THEN
       SUBGOAL_THEN ``y:real = c`` SUBST_ALL_TAC THENL
        [UNDISCH_TAC ``y <= c:real`` THEN POP_ASSUM MP_TAC THEN
         REAL_ARITH_TAC, ALL_TAC] THEN
       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (METIS []
        ``(gc - (g:real->real) c = k)
         ==> b <= (g c + (gc - g c)) ==> b <= (g c + k)``)) THEN
       REWRITE_TAC[REAL_ARITH ``a + (b - a:real) = b``] THEN
       MATCH_MP_TAC(ISPEC ``at c within interval[a:real,c]``
          LIM_DROP_LBOUND))
      THENL [EXISTS_TAC ``g:real->real``, EXISTS_TAC ``h:real->real``] THEN
      ASM_REWRITE_TAC[TRIVIAL_LIMIT_WITHIN, EVENTUALLY_WITHIN] THEN
      EXISTS_TAC ``c - x:real`` THEN
      (CONJ_TAC THENL [UNDISCH_TAC ``~(c <= x:real)`` THEN
                       REAL_ARITH_TAC, ALL_TAC]) THEN
      REWRITE_TAC[dist, IN_INTERVAL] THEN
      SIMP_TAC std_ss [IN_INTERVAL] THEN REPEAT STRIP_TAC THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
       UNDISCH_TAC `` a <= c /\ c <= b:real`` THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN REAL_ARITH_TAC,
      ALL_TAC] THEN
    SUBGOAL_THEN
     ``(g':real->real) continuous (at c within interval[a,c]) /\
       (h':real->real) continuous (at c within interval[a,c])``
    MP_TAC THENL
     [MAP_EVERY EXPAND_TAC ["g'", "h'"] THEN
      SIMP_TAC std_ss [CONTINUOUS_WITHIN, REAL_LE_REFL] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[REAL_ARITH
       ``(g - g':real = k) <=> (g' + k = g:real)``]) THEN
      ASM_REWRITE_TAC[] THEN CONJ_TAC THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
       (REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM)) THEN
      MAP_EVERY EXPAND_TAC ["g'", "h'"] THEN
      REWRITE_TAC[LIM_WITHIN, dist, IN_INTERVAL] THEN
      SIMP_TAC std_ss [REAL_ARITH ``x <= c /\ &0 < abs(x - c) ==> ~(c <= x:real)``] THEN
      REWRITE_TAC[REAL_SUB_REFL, ABS_N] THEN
      MESON_TAC[REAL_LT_01],
      ALL_TAC] THEN
    REWRITE_TAC[continuous_within] THEN
    SIMP_TAC std_ss [GSPECIFICATION, dist] THEN
    DISCH_THEN(fn th =>
      X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
      CONJUNCTS_THEN (MP_TAC o SPEC ``e / &2:real``) th) THEN
    ASM_REWRITE_TAC[REAL_HALF] THEN
    DISCH_THEN(X_CHOOSE_THEN ``d2:real`` STRIP_ASSUME_TAC) THEN
    DISCH_THEN(X_CHOOSE_THEN ``d1:real`` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC ``min d1 d2:real`` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
    X_GEN_TAC ``d:real`` THEN STRIP_TAC THEN
    MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``c:real``, ``d:real``]
          VECTOR_VARIATION_COMBINE) THEN
    KNOW_TAC ``a <= d /\ d <= c /\
      (f:real->real) has_bounded_variation_on interval [(a,c)]`` THENL
     [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
      ASM_SIMP_TAC real_ss [] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
         HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN
      REWRITE_TAC[SUBSET_INTERVAL] THEN
      UNDISCH_TAC ``a <= c /\ c <= b:real`` THEN REAL_ARITH_TAC,
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
      DISCH_THEN(SUBST1_TAC o SYM)] THEN
    REWRITE_TAC[REAL_ARITH ``abs(a - (a + b)) = abs b:real``] THEN
    MATCH_MP_TAC(REAL_ARITH ``&0 <= x /\ x < a ==> abs x < a:real``) THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC VECTOR_VARIATION_POS_LE THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
         HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
      REWRITE_TAC[SUBSET_INTERVAL] THEN ASM_SIMP_TAC real_ss [],
      ALL_TAC] THEN
    SUBGOAL_THEN ``f:real->real = \x. g' x - h' x`` SUBST1_TAC THENL
     [MAP_EVERY EXPAND_TAC ["g'", "h'"] THEN SIMP_TAC std_ss [FUN_EQ_THM] THEN
      GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [] THEN REAL_ARITH_TAC,
      ALL_TAC] THEN
    MP_TAC(ISPECL
     [``g':real->real``, ``\x. -((h':real->real) x)``,
      ``interval[d:real,c]``] VECTOR_VARIATION_TRIANGLE) THEN
    KNOW_TAC ``(g':real->real) has_bounded_variation_on interval [(d,c)] /\
       (\x. -h' x) has_bounded_variation_on interval [(d,c)]`` THENL
     [CONJ_TAC THENL [ALL_TAC, MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_NEG] THEN
      MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN
      EXISTS_TAC ``interval[a:real,c]`` THEN
      ASM_SIMP_TAC std_ss [INCREASING_BOUNDED_VARIATION, SUBSET_INTERVAL] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_SIMP_TAC real_ss [],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    SIMP_TAC std_ss [real_sub] THEN MATCH_MP_TAC(REAL_ARITH
     ``y * 2 < a /\ z * 2 < a ==> x <= y + z ==> x < a:real``) THEN
    REWRITE_TAC[VECTOR_VARIATION_NEG] THEN CONJ_TAC THEN
    SIMP_TAC real_ss [GSYM REAL_LT_RDIV_EQ] THEN
    W(MP_TAC o PART_MATCH (lhs o rand)
      INCREASING_VECTOR_VARIATION o lhand o snd) THENL
   [KNOW_TAC ``interval [(d,c)] <> {} /\
     (!x y. x IN interval [(d,c)] /\ y IN interval [(d,c)] /\ x <= y ==>
      g' x <= (g':real->real) y)`` THENL
      [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
       ASM_REWRITE_TAC[GSYM INTERVAL_EQ_EMPTY, IN_INTERVAL, REAL_NOT_LT] THEN
       REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
       UNDISCH_TAC `` a <= c /\ c <= b:real`` THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       REAL_ARITH_TAC,
       DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
       DISCH_THEN SUBST1_TAC],
    KNOW_TAC ``interval [(d,c)] <> {} /\
     (!x y. x IN interval [(d,c)] /\ y IN interval [(d,c)] /\ x <= y ==>
      h' x <= (h':real->real) y)`` THENL
      [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
       ASM_REWRITE_TAC[GSYM INTERVAL_EQ_EMPTY, IN_INTERVAL, REAL_NOT_LT] THEN
       REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
       UNDISCH_TAC `` a <= c /\ c <= b:real`` THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       REAL_ARITH_TAC,
       DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
       DISCH_THEN SUBST1_TAC]] THEN
    MATCH_MP_TAC(REAL_ARITH ``abs(x - y) < e ==> y - x < e:real``) THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);

val VECTOR_VARIATION_CONTINUOUS_LEFT = store_thm ("VECTOR_VARIATION_CONTINUOUS_LEFT",
 ``!f:real->real a b c.
        f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b]
        ==> ((\x. (vector_variation(interval[a,x]) f))
             continuous (at c within interval[a,c]) <=>
            f continuous (at c within interval[a,c]))``,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [REWRITE_TAC[continuous_within] THEN
    SIMP_TAC std_ss [GSPECIFICATION, dist] THEN
    DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``e:real``) THEN ASM_REWRITE_TAC[] THEN
    STRIP_TAC THEN EXISTS_TAC ``d:real`` THEN
    ASM_REWRITE_TAC[] THEN X_GEN_TAC ``x:real`` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN
    MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``c:real``, ``x:real``]
        VECTOR_VARIATION_COMBINE) THEN
    KNOW_TAC ``a <= x /\ x <= c /\
              (f:real->real) has_bounded_variation_on interval [(a,c)]`` THENL
     [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
      REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC, ALL_TAC]) THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
         HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN
      REWRITE_TAC[SUBSET_INTERVAL] THEN ASM_REAL_ARITH_TAC,
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    DISCH_THEN(SUBST1_TAC o SYM) THEN
    REWRITE_TAC[REAL_ARITH ``abs(a - (a + b)) = abs b:real``] THEN
    REWRITE_TAC[dist] THEN
    MATCH_MP_TAC(REAL_ARITH ``x <= a ==> x <= abs a:real``) THEN
    ONCE_REWRITE_TAC[ABS_SUB] THEN
    MATCH_MP_TAC VECTOR_VARIATION_GE_ABS_FUNCTION THEN CONJ_TAC THENL
     [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        HAS_BOUNDED_VARIATION_ON_SUBSET)),
      REWRITE_TAC[SEGMENT] THEN COND_CASES_TAC] THEN
    REWRITE_TAC[SUBSET_INTERVAL] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_REAL_ARITH_TAC,
    ALL_TAC] THEN
  DISCH_TAC THEN ASM_CASES_TAC ``c limit_point_of interval[a:real,c]`` THENL
   [ALL_TAC,
    ASM_REWRITE_TAC[CONTINUOUS_WITHIN, LIM, TRIVIAL_LIMIT_WITHIN]] THEN
  MATCH_MP_TAC(CONTINUOUS_WITHIN_COMPARISON) THEN
  EXISTS_TAC ``\x. sum ((1:num)..(1:num))
                       (\i. (vector_variation (interval[a,x])
                            (\u. (((f:real->real) u)))))`` THEN
  SIMP_TAC std_ss [] THEN CONJ_TAC THENL
   [ONCE_REWRITE_TAC [METIS []
     ``((\x. sum ((1:num) .. (1:num))
     (\i. vector_variation (interval [(a,x)]) (\u. f u)))) =
       ((\x. sum ((1:num) .. (1:num))
     (\i. (\i x. vector_variation (interval [(a,x)]) (\u. f u)) i x)))``] THEN
    MATCH_MP_TAC CONTINUOUS_SUM THEN SIMP_TAC std_ss [FINITE_NUMSEG] THEN
    REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN
    W(MP_TAC o PART_MATCH (lhs o rand) lemma o snd) THEN
    METIS_TAC [],
    ALL_TAC] THEN
  X_GEN_TAC ``x:real`` THEN REWRITE_TAC[IN_INTERVAL] THEN DISCH_TAC THEN
  REWRITE_TAC[dist, GSYM SUM_SUB_NUMSEG] THEN
  SUBGOAL_THEN
  ``(vector_variation(interval [a,c]) (f:real->real) =
     vector_variation(interval [a,x]) (f:real->real) +
     vector_variation(interval [x,c]) (f:real->real)) /\
    (vector_variation(interval [a,c]) (\x. ((f:real->real) x)) =
     vector_variation(interval [a,x]) (\x. (f x)) +
     vector_variation(interval [x,c]) (\x. (f x)))``
   (fn th => ASM_SIMP_TAC std_ss [th])
  THENL
   [REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
    MATCH_MP_TAC VECTOR_VARIATION_COMBINE THEN
    ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN
    EXISTS_TAC ``interval[a:real,b]`` THEN
    ASM_REWRITE_TAC[SUBSET_INTERVAL] THEN
    RULE_ASSUM_TAC(ONCE_REWRITE_RULE
       [HAS_BOUNDED_VARIATION_ON_COMPONENTWISE]) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
    ASM_SIMP_TAC std_ss [REAL_LE_REFL],
    REWRITE_TAC[REAL_ADD_SUB]] THEN
  SIMP_TAC std_ss [NUMSEG_SING, SUM_SING, ETA_AX, REAL_LE_REFL]);

val lemma = prove (
   ``!f:real->real a b c.
          f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b]
          ==> ((\x. (vector_variation(interval[a,x]) f))
               continuous (at c within interval[c,b]) <=>
              f continuous (at c within interval[c,b]))``,
    REPEAT STRIP_TAC THEN EQ_TAC THENL
     [REWRITE_TAC[continuous_within] THEN
      SIMP_TAC std_ss [GSPECIFICATION, dist] THEN
      DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC ``e:real``) THEN ASM_REWRITE_TAC[] THEN
      STRIP_TAC THEN EXISTS_TAC ``d:real`` THEN
      ASM_REWRITE_TAC[] THEN X_GEN_TAC ``x:real`` THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN
      MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``x:real``, ``c:real``]
          VECTOR_VARIATION_COMBINE) THEN
      KNOW_TAC ``a <= c /\ c <= x /\
                (f:real->real) has_bounded_variation_on interval [(a,x)]`` THENL
       [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
        REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC, ALL_TAC]) THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
           HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN
        REWRITE_TAC[SUBSET_INTERVAL] THEN ASM_REAL_ARITH_TAC,
        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
      DISCH_THEN(SUBST1_TAC o SYM) THEN
      REWRITE_TAC[REAL_ARITH ``abs((a + b) - a) = abs b:real``] THEN
      MATCH_MP_TAC(REAL_ARITH ``x <= a ==> x <= abs a:real``) THEN
      MATCH_MP_TAC VECTOR_VARIATION_GE_ABS_FUNCTION THEN CONJ_TAC THENL
       [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          HAS_BOUNDED_VARIATION_ON_SUBSET)),
        REWRITE_TAC[SEGMENT] THEN COND_CASES_TAC] THEN
      REWRITE_TAC[SUBSET_INTERVAL] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_REAL_ARITH_TAC,
      ALL_TAC] THEN
    DISCH_TAC THEN ASM_CASES_TAC ``c limit_point_of interval[c:real,b]`` THENL
     [ALL_TAC,
      ASM_REWRITE_TAC[CONTINUOUS_WITHIN, LIM, TRIVIAL_LIMIT_WITHIN]] THEN
    UNDISCH_TAC ``(f:real->real) has_bounded_variation_on interval [(a,b)]`` THEN
    DISCH_TAC THEN FIRST_ASSUM(MP_TAC o
      REWRITE_RULE [HAS_BOUNDED_VARIATION_DARBOUX]) THEN
    SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [``g:real->real``, ``h:real->real``] THEN
    STRIP_TAC THEN
    MP_TAC(ISPECL [``h:real->real``, ``a:real``, ``b:real``, ``c:real``]
     INCREASING_RIGHT_LIMIT) THEN
    MP_TAC(ISPECL [``g:real->real``, ``a:real``, ``b:real``, ``c:real``]
     INCREASING_RIGHT_LIMIT) THEN
    ASM_SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC ``gc:real`` THEN DISCH_TAC THEN
    X_GEN_TAC ``hc:real`` THEN DISCH_TAC THEN
    ABBREV_TAC ``k = gc - (g:real->real) c`` THEN
    SUBGOAL_THEN ``hc - (h:real->real) c = k`` ASSUME_TAC THENL
     [EXPAND_TAC "k" THEN
      ONCE_REWRITE_TAC[REAL_ARITH
       ``(hc' - hc:real = gc' - gc) <=> (gc' - hc' = gc - hc)``] THEN
      UNDISCH_TAC ``f continuous (at c within interval [(c,b)])`` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o REWRITE_RULE [CONTINUOUS_WITHIN]) THEN
      ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC(REWRITE_RULE[TAUT`a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`]
        LIM_UNIQUE) THEN
      ASM_REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN
      GEN_REWR_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN
      ASM_SIMP_TAC std_ss [LIM_SUB],
      ALL_TAC] THEN
    MAP_EVERY ABBREV_TAC
     [``g':real->real = \x. if x <= c then g(x) + k else g(x)``,
      ``h':real->real =
          \x. if x <= c then h(x) + k else h(x)``] THEN
    SUBGOAL_THEN
     ``(!x y. x IN interval[c,b] /\ y IN interval[c,b] /\ x <= y
             ==> (g' x) <= ((g':real->real) y)) /\
       (!x y. x IN interval[c,b] /\ y IN interval[c,b] /\ x <= y
             ==> (h' x) <= ((h':real->real) y))``
    STRIP_ASSUME_TAC THENL
     [MAP_EVERY EXPAND_TAC ["g'", "h'"] THEN SIMP_TAC std_ss [] THEN CONJ_TAC THEN
      MAP_EVERY X_GEN_TAC [``x:real``, ``y:real``] THEN
      REWRITE_TAC[IN_INTERVAL] THEN STRIP_TAC THEN
      (ASM_CASES_TAC ``y <= c:real`` THENL
        [SUBGOAL_THEN ``x <= c:real`` ASSUME_TAC THENL
          [POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
           REAL_ARITH_TAC, ASM_REWRITE_TAC[]] THEN
         SIMP_TAC std_ss [REAL_LE_RADD] THEN
         FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN
         RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
         UNDISCH_TAC `` a <= c /\ c <= b:real`` THEN
         POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
         POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
         POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
         POP_ASSUM MP_TAC THEN REAL_ARITH_TAC,
         ALL_TAC] THEN
       ASM_SIMP_TAC std_ss [] THEN COND_CASES_TAC THEN ASM_SIMP_TAC std_ss [] THENL
        [ALL_TAC,
         FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN
         RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
         UNDISCH_TAC `` a <= c /\ c <= b:real`` THEN
         POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
         POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
         POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
         POP_ASSUM MP_TAC THEN REAL_ARITH_TAC] THEN
       SUBGOAL_THEN ``x:real = c`` SUBST_ALL_TAC THENL
        [UNDISCH_TAC ``c <= x:real`` THEN POP_ASSUM MP_TAC THEN
         REAL_ARITH_TAC, ALL_TAC] THEN
       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
        ``(gc - (g:real->real) c = k)
         ==> (g c + (gc - g c)) <= b ==> (g c + k) <= b``)) THEN
       REWRITE_TAC[REAL_ARITH ``a + (b - a:real) = b``] THEN
       MATCH_MP_TAC(ISPEC ``at c within interval[c:real,b]``
          LIM_DROP_UBOUND))
      THENL [EXISTS_TAC ``g:real->real``, EXISTS_TAC ``h:real->real``] THEN
      ASM_SIMP_TAC std_ss [TRIVIAL_LIMIT_WITHIN, EVENTUALLY_WITHIN] THEN
      EXISTS_TAC ``y - c:real`` THEN
      (CONJ_TAC THENL [POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
                       REAL_ARITH_TAC, ALL_TAC]) THEN
      REWRITE_TAC[dist, IN_INTERVAL] THEN
      SIMP_TAC std_ss [IN_INTERVAL] THEN REPEAT STRIP_TAC THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
      UNDISCH_TAC `` a <= c /\ c <= b:real`` THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN REAL_ARITH_TAC,
      ALL_TAC] THEN
    SUBGOAL_THEN
     ``(g':real->real) continuous (at c within interval[c,b]) /\
       (h':real->real) continuous (at c within interval[c,b])``
    MP_TAC THENL
     [MAP_EVERY EXPAND_TAC ["g'", "h'"] THEN
      SIMP_TAC std_ss [CONTINUOUS_WITHIN, REAL_LE_REFL] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[REAL_ARITH
       ``(g - g':real = k) <=> (g' + k = g:real)``]) THEN
      ASM_SIMP_TAC std_ss [] THEN CONJ_TAC THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
       (REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM)) THEN
      MAP_EVERY EXPAND_TAC ["g'", "h'"] THEN
      SIMP_TAC std_ss [LIM_WITHIN, dist, IN_INTERVAL] THEN
      SIMP_TAC std_ss [REAL_ARITH ``c <= x /\ &0 < abs(x - c) ==> ~(x <= c:real)``] THEN
      REWRITE_TAC[REAL_SUB_REFL, ABS_N] THEN
      MESON_TAC[REAL_LT_01],
      ALL_TAC] THEN
    REWRITE_TAC[continuous_within] THEN
    SIMP_TAC std_ss [dist, GSPECIFICATION] THEN
    DISCH_THEN(fn th =>
      X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
      CONJUNCTS_THEN (MP_TAC o SPEC ``e / &2:real``) th) THEN
    ASM_REWRITE_TAC[REAL_HALF] THEN
    DISCH_THEN(X_CHOOSE_THEN ``d2:real`` STRIP_ASSUME_TAC) THEN
    DISCH_THEN(X_CHOOSE_THEN ``d1:real`` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC ``min d1 d2:real`` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
    X_GEN_TAC ``d:real`` THEN STRIP_TAC THEN
    MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``d:real``, ``c:real``]
          VECTOR_VARIATION_COMBINE) THEN
    KNOW_TAC ``a <= c /\ c <= d /\
              (f:real->real) has_bounded_variation_on interval [(a,d)]`` THENL
     [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
      ASM_SIMP_TAC real_ss [] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
         HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN
      REWRITE_TAC[SUBSET_INTERVAL] THEN ASM_SIMP_TAC real_ss [],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
      DISCH_THEN(SUBST1_TAC o SYM)] THEN
    REWRITE_TAC[REAL_ARITH ``(a + b) - a:real = b:real``] THEN
    MATCH_MP_TAC(REAL_ARITH ``&0 <= x /\ x < a ==> abs x < a:real``) THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC VECTOR_VARIATION_POS_LE THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
         HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
      REWRITE_TAC[SUBSET_INTERVAL] THEN ASM_SIMP_TAC real_ss [],
      ALL_TAC] THEN
    SUBGOAL_THEN ``f:real->real = \x. g' x - h' x`` SUBST1_TAC THENL
     [MAP_EVERY EXPAND_TAC ["g'", "h'"] THEN SIMP_TAC std_ss [FUN_EQ_THM] THEN
      GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC,
      ALL_TAC] THEN
    MP_TAC(ISPECL
     [``g':real->real``, ``\x. -((h':real->real) x)``,
      ``interval[c:real,d]``] VECTOR_VARIATION_TRIANGLE) THEN
    KNOW_TAC ``(g':real->real) has_bounded_variation_on interval [(c,d)] /\
          (\x. -h' x) has_bounded_variation_on interval [(c,d)]`` THENL
     [CONJ_TAC THENL [ALL_TAC, MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_NEG] THEN
      MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN
      EXISTS_TAC ``interval[c:real,b]`` THEN
      ASM_SIMP_TAC std_ss [INCREASING_BOUNDED_VARIATION, SUBSET_INTERVAL] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_SIMP_TAC real_ss [],
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    SIMP_TAC std_ss [real_sub] THEN MATCH_MP_TAC(REAL_ARITH
     ``y * 2 < a /\ z * 2 < a ==> x <= y + z ==> x < a:real``) THEN
    SIMP_TAC std_ss [VECTOR_VARIATION_NEG] THEN CONJ_TAC THEN
    SIMP_TAC real_ss [GSYM REAL_LT_RDIV_EQ] THEN
    W(MP_TAC o PART_MATCH (lhs o rand)
      INCREASING_VECTOR_VARIATION o lhand o snd) THENL
   [KNOW_TAC ``interval [(c,d)] <> {} /\
     (!x y. x IN interval [(c,d)] /\ y IN interval [(c,d)] /\ x <= y ==>
      g' x <= (g':real->real) y)`` THENL
      [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
       ASM_REWRITE_TAC[GSYM INTERVAL_EQ_EMPTY, IN_INTERVAL, REAL_NOT_LT] THEN
       REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
       UNDISCH_TAC `` a <= c /\ c <= b:real`` THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       REAL_ARITH_TAC,
       DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
       DISCH_THEN SUBST1_TAC],
    KNOW_TAC ``interval [(c,d)] <> {} /\
     (!x y. x IN interval [(c,d)] /\ y IN interval [(c,d)] /\ x <= y ==>
      h' x <= (h':real->real) y)`` THENL
      [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
       ASM_REWRITE_TAC[GSYM INTERVAL_EQ_EMPTY, IN_INTERVAL, REAL_NOT_LT] THEN
       REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
       UNDISCH_TAC `` a <= c /\ c <= b:real`` THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
       REAL_ARITH_TAC,
       DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
       DISCH_THEN SUBST1_TAC]] THEN
    MATCH_MP_TAC(REAL_ARITH ``abs(x - y) < e ==> y - x < e:real``) THEN
    ONCE_REWRITE_TAC [ABS_SUB] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);

val VECTOR_VARIATION_CONTINUOUS_RIGHT = store_thm ("VECTOR_VARIATION_CONTINUOUS_RIGHT",
 ``!f:real->real a b c.
        f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b]
        ==> ((\x. (vector_variation(interval[a,x]) f))
             continuous (at c within interval[c,b]) <=>
            f continuous (at c within interval[c,b]))``,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [REWRITE_TAC[continuous_within] THEN
    SIMP_TAC std_ss [GSPECIFICATION, dist] THEN
    DISCH_TAC THEN X_GEN_TAC ``e:real`` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``e:real``) THEN ASM_REWRITE_TAC[] THEN
    STRIP_TAC THEN EXISTS_TAC ``d:real`` THEN
    ASM_REWRITE_TAC[] THEN X_GEN_TAC ``x:real`` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC ``x:real``) THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN
    MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``x:real``, ``c:real``]
        VECTOR_VARIATION_COMBINE) THEN
    KNOW_TAC ``a <= c /\ c <= x /\
              (f:real->real) has_bounded_variation_on interval [(a,x)]`` THENL
     [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
      REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC, ALL_TAC]) THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
         HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN
      REWRITE_TAC[SUBSET_INTERVAL] THEN ASM_REAL_ARITH_TAC,
      DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
    DISCH_THEN(SUBST1_TAC o SYM) THEN
    REWRITE_TAC[REAL_ARITH ``abs((a + b) - a) = abs b:real``] THEN
    REWRITE_TAC[dist] THEN
    MATCH_MP_TAC(REAL_ARITH ``x <= a ==> x <= abs a:real``) THEN
    ONCE_REWRITE_TAC[ABS_SUB] THEN
    MATCH_MP_TAC VECTOR_VARIATION_GE_ABS_FUNCTION THEN CONJ_TAC THENL
     [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        HAS_BOUNDED_VARIATION_ON_SUBSET)),
      REWRITE_TAC[SEGMENT] THEN COND_CASES_TAC] THEN
    REWRITE_TAC[SUBSET_INTERVAL] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_SIMP_TAC real_ss [],
    ALL_TAC] THEN
  DISCH_TAC THEN ASM_CASES_TAC ``c limit_point_of interval[c:real,b]`` THENL
   [ALL_TAC,
    ASM_REWRITE_TAC[CONTINUOUS_WITHIN, LIM, TRIVIAL_LIMIT_WITHIN]] THEN
  MATCH_MP_TAC(CONTINUOUS_WITHIN_COMPARISON) THEN
  EXISTS_TAC ``\x. sum ((1:num)..(1:num))
                       (\i. (vector_variation (interval[a,x])
                            (\u. (((f:real->real) u)))))`` THEN
  SIMP_TAC std_ss [] THEN CONJ_TAC THENL
   [ONCE_REWRITE_TAC [METIS []
     ``(\i. vector_variation (interval [(a,x)]) (\u. f u)) =
       (\i. (\i x. vector_variation (interval [(a,x)]) (\u. f u)) i x)``] THEN
    MATCH_MP_TAC CONTINUOUS_SUM THEN REWRITE_TAC[FINITE_NUMSEG] THEN
    REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN
    W(MP_TAC o PART_MATCH (lhs o rand) lemma o snd) THEN
    METIS_TAC [],
    ALL_TAC] THEN
  X_GEN_TAC ``x:real`` THEN REWRITE_TAC[IN_INTERVAL] THEN DISCH_TAC THEN
  SIMP_TAC std_ss [dist, GSYM SUM_SUB_NUMSEG] THEN
  SUBGOAL_THEN
  ``(vector_variation(interval [a,x]) (f:real->real) =
     vector_variation(interval [a,c]) (f:real->real) +
     vector_variation(interval [c,x]) (f:real->real)) /\
    (vector_variation(interval [a,x])
                  (\x. ((f:real->real) x)) =
     vector_variation(interval [a,c]) (\x. (f x)) +
     vector_variation(interval [c,x]) (\x. (f x)))``
   (fn th => ASM_SIMP_TAC std_ss [th])
  THENL
   [REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
    MATCH_MP_TAC VECTOR_VARIATION_COMBINE THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
    ASM_SIMP_TAC std_ss [] THEN
    MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN
    EXISTS_TAC ``interval[a:real,b]`` THEN
    ASM_REWRITE_TAC[SUBSET_INTERVAL] THEN
    RULE_ASSUM_TAC(ONCE_REWRITE_RULE
       [HAS_BOUNDED_VARIATION_ON_COMPONENTWISE]) THEN
    ASM_SIMP_TAC std_ss [REAL_LE_REFL],
    REWRITE_TAC[REAL_ARITH ``a - (a + b):real = -b``]] THEN
  SIMP_TAC std_ss [NUMSEG_SING, SUM_SING, ETA_AX, REAL_LE_REFL]);

val lemma = prove (
    ``!f:real->real a b c.
        c IN interval[a,b]
        ==> (f continuous (at c within interval[a,b]) <=>
             f continuous (at c within interval[a,c]) /\
             f continuous (at c within interval[c,b]))``,
     REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_WITHIN] THEN EQ_TAC THENL
      [DISCH_THEN(ASSUME_TAC o GEN_ALL o
       MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_WITHIN_SUBSET)) THEN
       CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC,
       DISCH_THEN(MP_TAC o MATCH_MP LIM_UNION) THEN
       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LIM_WITHIN_SUBSET)] THEN
     REWRITE_TAC[SUBSET_DEF, IN_UNION, IN_INTERVAL] THEN
     RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_REAL_ARITH_TAC);

val VECTOR_VARIATION_CONTINUOUS = store_thm ("VECTOR_VARIATION_CONTINUOUS",
 ``!f:real->real a b c.
        f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b]
        ==> ((\x. (vector_variation(interval[a,x]) f))
             continuous (at c within interval[a,b]) <=>
            f continuous (at c within interval[a,b]))``,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(fn th => ONCE_REWRITE_TAC[MATCH_MP lemma th]) THEN
  METIS_TAC[VECTOR_VARIATION_CONTINUOUS_LEFT,
                VECTOR_VARIATION_CONTINUOUS_RIGHT]);

val CONTINUOUS_ON_VECTOR_VARIATION = store_thm ("CONTINUOUS_ON_VECTOR_VARIATION",
 ``!f:real->real a b.
        f has_bounded_variation_on interval[a,b] /\
        f continuous_on interval[a,b]
        ==> (\x. (vector_variation (interval [a,x]) f)) continuous_on
            interval[a,b]``,
  SIMP_TAC std_ss [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN, VECTOR_VARIATION_CONTINUOUS]);

val HAS_BOUNDED_VARIATION_DARBOUX_STRONG = store_thm ("HAS_BOUNDED_VARIATION_DARBOUX_STRONG",
 ``!f a b.
     f has_bounded_variation_on interval[a,b]
     ==> ?g h. (!x. f x = g x - h x) /\
               (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\
                      x <= y
                      ==> (g x) <= (g y)) /\
               (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\
                      x <= y
                      ==> (h x) <= (h y)) /\
               (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\
                      x < y
                      ==> (g x) < (g y)) /\
               (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\
                      x < y
                      ==> (h x) < (h y)) /\
               (!x. x IN interval[a,b] /\
                    f continuous (at x within interval[a,x])
                    ==> g continuous (at x within interval[a,x]) /\
                        h continuous (at x within interval[a,x])) /\
               (!x. x IN interval[a,b] /\
                    f continuous (at x within interval[x,b])
                    ==> g continuous (at x within interval[x,b]) /\
                        h continuous (at x within interval[x,b])) /\
               (!x. x IN interval[a,b] /\
                    f continuous (at x within interval[a,b])
                    ==> g continuous (at x within interval[a,b]) /\
                        h continuous (at x within interval[a,b]))``,
  REPEAT STRIP_TAC THEN
  MAP_EVERY EXISTS_TAC
   [``\x:real. x + (vector_variation (interval[a,x]) (f:real->real))``,
    ``\x:real. x + (vector_variation (interval[a,x]) f) - f x``] THEN
  SIMP_TAC real_ss [REAL_ARITH ``(x + l) - (x + l - f):real = f``] THEN
  SIMP_TAC std_ss [] THEN REPEAT STRIP_TAC THENL
   [MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC VECTOR_VARIATION_MONOTONE,
    REWRITE_TAC [real_sub, GSYM REAL_ADD_ASSOC] THEN
    MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[GSYM real_sub] THEN
    MATCH_MP_TAC(REAL_ARITH
     ``!x. a - (b - x) <= c - (d - x) ==> a - b <= c - d:real``) THEN
    EXISTS_TAC ``(f(a:real)):real`` THEN
    SIMP_TAC std_ss [] THEN
    MATCH_MP_TAC VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE,
    MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC VECTOR_VARIATION_MONOTONE,
    REWRITE_TAC [real_sub, GSYM REAL_ADD_ASSOC] THEN
    MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[GSYM real_sub] THEN
    MATCH_MP_TAC(REAL_ARITH
     ``!x. a - (b - x) <= c - (d - x) ==> a - b <= c - d:real``) THEN
    EXISTS_TAC ``(f(a:real)):real`` THEN
    SIMP_TAC std_ss [] THEN
    MATCH_MP_TAC VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE,
    ONCE_REWRITE_TAC [METIS []
     ``(\x. x + vector_variation (interval [(a,x)]) f) =
       (\x. (\x. x) x + (\x. vector_variation (interval [(a,x)]) f) x)``] THEN
    MATCH_MP_TAC CONTINUOUS_ADD THEN
    REWRITE_TAC[CONTINUOUS_WITHIN_ID] THEN
    MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``b:real``, ``x:real``]
        VECTOR_VARIATION_CONTINUOUS_LEFT) THEN
    ASM_REWRITE_TAC[],
    ONCE_REWRITE_TAC [METIS [real_sub, REAL_ADD_ASSOC]
      ``(\x. x + vector_variation (interval [(a,x)]) f - f x) =
        (\x. (\x. x) x + (\x. vector_variation (interval [(a,x)]) f - f x) x)``] THEN
    MATCH_MP_TAC CONTINUOUS_ADD THEN
    REWRITE_TAC[CONTINUOUS_WITHIN_ID] THEN
    ONCE_REWRITE_TAC [METIS []
      ``(\x. vector_variation (interval [(a,x)]) f - f x) =
        (\x. (\x. vector_variation (interval [(a,x)]) f) x - f x)``] THEN
    MATCH_MP_TAC CONTINUOUS_SUB THEN ASM_REWRITE_TAC[] THEN
    MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``b:real``, ``x:real``]
        VECTOR_VARIATION_CONTINUOUS_LEFT) THEN
    ASM_REWRITE_TAC[],
    ONCE_REWRITE_TAC [METIS []
     ``(\x. x + vector_variation (interval [(a,x)]) f) =
       (\x. (\x. x) x + (\x. vector_variation (interval [(a,x)]) f) x)``] THEN
    MATCH_MP_TAC CONTINUOUS_ADD THEN
    REWRITE_TAC[CONTINUOUS_WITHIN_ID] THEN
    MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``b:real``, ``x:real``]
        VECTOR_VARIATION_CONTINUOUS_RIGHT) THEN
    ASM_REWRITE_TAC[],
    ONCE_REWRITE_TAC [METIS [real_sub, REAL_ADD_ASSOC]
      ``(\x. x + vector_variation (interval [(a,x)]) f - f x) =
        (\x. (\x. x) x + (\x. vector_variation (interval [(a,x)]) f - f x) x)``] THEN
    MATCH_MP_TAC CONTINUOUS_ADD THEN
    REWRITE_TAC[CONTINUOUS_WITHIN_ID] THEN
    ONCE_REWRITE_TAC [METIS []
      ``(\x. vector_variation (interval [(a,x)]) f - f x) =
        (\x. (\x. vector_variation (interval [(a,x)]) f) x - f x)``] THEN
    MATCH_MP_TAC CONTINUOUS_SUB THEN ASM_REWRITE_TAC[] THEN
    MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``b:real``, ``x:real``]
        VECTOR_VARIATION_CONTINUOUS_RIGHT) THEN
    ASM_REWRITE_TAC[],
    ONCE_REWRITE_TAC [METIS []
     ``(\x. x + vector_variation (interval [(a,x)]) f) =
       (\x. (\x. x) x + (\x. vector_variation (interval [(a,x)]) f) x)``] THEN
    MATCH_MP_TAC CONTINUOUS_ADD THEN
    REWRITE_TAC[CONTINUOUS_WITHIN_ID] THEN
    MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``b:real``, ``x:real``]
        VECTOR_VARIATION_CONTINUOUS) THEN
    ASM_REWRITE_TAC[],
    ONCE_REWRITE_TAC [METIS [real_sub, REAL_ADD_ASSOC]
      ``(\x. x + vector_variation (interval [(a,x)]) f - f x) =
        (\x. (\x. x) x + (\x. vector_variation (interval [(a,x)]) f - f x) x)``] THEN
    MATCH_MP_TAC CONTINUOUS_ADD THEN
    REWRITE_TAC[CONTINUOUS_WITHIN_ID] THEN
    ONCE_REWRITE_TAC [METIS []
      ``(\x. vector_variation (interval [(a,x)]) f - f x) =
        (\x. (\x. vector_variation (interval [(a,x)]) f) x - f x)``] THEN
    MATCH_MP_TAC CONTINUOUS_SUB THEN ASM_REWRITE_TAC[] THEN
    MP_TAC(ISPECL [``f:real->real``, ``a:real``, ``b:real``, ``x:real``]
        VECTOR_VARIATION_CONTINUOUS) THEN
    ASM_REWRITE_TAC[]] THEN
  (CONJ_TAC THENL
     [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
       HAS_BOUNDED_VARIATION_ON_SUBSET)),
      ALL_TAC] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN
    REWRITE_TAC[SUBSET_INTERVAL, GSYM INTERVAL_EQ_EMPTY] THEN
    ASM_REAL_ARITH_TAC));

val INTEGRABLE_BOUNDED_VARIATION_PRODUCT = store_thm ("INTEGRABLE_BOUNDED_VARIATION_PRODUCT",
 ``!f:real->real g a b.
        f integrable_on interval[a,b] /\
        g has_bounded_variation_on interval[a,b]
        ==> (\x. (g x) * f x) integrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM
   (MP_TAC o REWRITE_RULE [HAS_BOUNDED_VARIATION_DARBOUX]) THEN
  SIMP_TAC std_ss [LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [``h:real->real``, ``k:real->real``] THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[REAL_SUB_RDISTRIB] THEN
  ONCE_REWRITE_TAC [METIS [] ``(\x. h x * f x - k x * (f:real->real) x) =
                  (\x. (\x. h x * f x) x - (\x. k x * f x) x)``] THEN
  MATCH_MP_TAC INTEGRABLE_SUB THEN
  CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_INCREASING_PRODUCT THEN
  ASM_REWRITE_TAC[]);

val INTEGRABLE_BOUNDED_VARIATION_PRODUCT_ALT = store_thm ("INTEGRABLE_BOUNDED_VARIATION_PRODUCT_ALT",
 ``!f:real->real g a b.
        f integrable_on interval[a,b] /\
         g has_bounded_variation_on interval[a,b]
        ==> (\x. g x * f x) integrable_on interval[a,b]``,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_BOUNDED_VARIATION_PRODUCT) THEN
  SIMP_TAC std_ss [o_DEF]);

val INTEGRABLE_BOUNDED_VARIATION_BILINEAR_LMUL = store_thm ("INTEGRABLE_BOUNDED_VARIATION_BILINEAR_LMUL",
 ``!op:real->real->real f g a b.
        bilinear op /\
        f integrable_on interval[a,b] /\
        g has_bounded_variation_on interval[a,b]
        ==> (\x. op (g x) (f x)) integrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN
  KNOW_TAC ``!x. (g:real->real) x = sum ((1:num)..(1:num)) (\i. g x * &i)`` THENL
  [SIMP_TAC std_ss [SUM_SING, NUMSEG_SING, REAL_MUL_RID],
   DISCH_TAC THEN ONCE_ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC] THEN
  FIRST_ASSUM(ASSUME_TAC o CONJUNCT2 o REWRITE_RULE [bilinear]) THEN
  KNOW_TAC ``!n y g. FINITE ((1:num).. n) ==>
    ((\(x:real). (op:real->real->real) x y) (sum ((1:num)..n) g) =
     sum ((1:num)..n) ((\x. op x y) o g))`` THENL
  [REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_SUM THEN ASM_SIMP_TAC std_ss [],
   ALL_TAC] THEN
  SIMP_TAC std_ss [FINITE_NUMSEG, o_DEF] THEN DISCH_THEN(K ALL_TAC) THEN
  ONCE_REWRITE_TAC [METIS []
   ``(\x. sum (1 .. 1) (\i. op ((g:real->real) x * &i) (f x))) =
     (\x. sum (1 .. 1) (\i. (\i x. op (g x * &i) (f x)) i x))``] THEN
  MATCH_MP_TAC INTEGRABLE_SUM THEN SIMP_TAC std_ss [FINITE_NUMSEG, IN_NUMSEG] THEN
  X_GEN_TAC ``k:num`` THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o GEN_ALL o MATCH_MP LINEAR_CMUL o SPEC_ALL) THEN
  SIMP_TAC std_ss [] THEN DISCH_THEN(K ALL_TAC) THEN
  ONCE_REWRITE_TAC [METIS [] ``(\x. (g:real->real) x * op (&k) (f x)) =
                    (\x. g x * (\x. (op:real->real->real) (&k) (f x)) x)``] THEN
  MATCH_MP_TAC INTEGRABLE_BOUNDED_VARIATION_PRODUCT_ALT THEN
  ASM_SIMP_TAC std_ss [o_DEF, IN_NUMSEG] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN
  MATCH_MP_TAC INTEGRABLE_LINEAR THEN ASM_REWRITE_TAC[] THEN
  UNDISCH_TAC ``bilinear op`` THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o CONJUNCT1 o SIMP_RULE std_ss [bilinear]) THEN
  METIS_TAC [ETA_AX]);

val INTEGRABLE_BOUNDED_VARIATION_BILINEAR_RMUL = store_thm ("INTEGRABLE_BOUNDED_VARIATION_BILINEAR_RMUL",
 ``!op:real->real->real f g a b.
        bilinear op /\
        f integrable_on interval[a,b] /\
        g has_bounded_variation_on interval[a,b]
        ==> (\x. op (f x) (g x)) integrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN MP_TAC(ISPECL
   [``\x y. (op:real->real->real) y x``,
    ``f:real->real``, ``g:real->real``,
    ``a:real``, ``b:real``] INTEGRABLE_BOUNDED_VARIATION_BILINEAR_LMUL) THEN
  ASM_SIMP_TAC std_ss [BILINEAR_SWAP]);

val INTEGRABLE_BOUNDED_VARIATION = store_thm ("INTEGRABLE_BOUNDED_VARIATION",
 ``!f:real->real a b.
        f has_bounded_variation_on interval[a,b]
        ==> f integrable_on interval[a,b]``,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL
   [``\x:real y:real. x * y``,
    ``(\x. 1):real->real``,
    ``f:real->real``, ``a:real``, ``b:real``]
        INTEGRABLE_BOUNDED_VARIATION_BILINEAR_RMUL) THEN
  ASM_SIMP_TAC std_ss [INTEGRABLE_CONST, BILINEAR_DOT] THEN
  SIMP_TAC std_ss [REAL_MUL_LID, ETA_AX]);

val HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_RIGHT = store_thm ("HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_RIGHT",
 ``!f:real->real a b.
        f absolutely_integrable_on interval[a,b]
        ==> (\c. integral (interval[a,c]) f) has_bounded_variation_on
            interval[a,b]``,
  REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN
  FIRST_ASSUM(MP_TAC o
    MATCH_MP ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_SETVARIATION_ON_EQ) THEN
  SIMP_TAC std_ss [INTERVAL_LOWERBOUND_NONEMPTY, INTERVAL_UPPERBOUND_NONEMPTY] THEN
  SIMP_TAC std_ss [INTERVAL_NE_EMPTY, SUBSET_INTERVAL, GSYM REAL_NOT_LE] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH
   ``(a:real = b - c) <=> (c + a = b)``] THEN
  MATCH_MP_TAC INTEGRAL_COMBINE THEN ASM_REWRITE_TAC[] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTEGRABLE_ON_SUBINTERVAL) THEN
  ASM_REWRITE_TAC[SUBSET_INTERVAL] THEN ASM_REAL_ARITH_TAC);

val HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_LEFT = store_thm ("HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_LEFT",
 ``!f:real->real a b.
        f absolutely_integrable_on interval[a,b]
        ==> (\c. integral (interval[c,b]) f) has_bounded_variation_on
            interval[a,b]``,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[has_bounded_variation_on] THEN
  ONCE_REWRITE_TAC[GSYM HAS_BOUNDED_SETVARIATION_ON_NEG] THEN
  FIRST_ASSUM(MP_TAC o
    MATCH_MP ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_SETVARIATION_ON_EQ) THEN
  SIMP_TAC std_ss [INTERVAL_LOWERBOUND_NONEMPTY, INTERVAL_UPPERBOUND_NONEMPTY] THEN
  SIMP_TAC std_ss [INTERVAL_NE_EMPTY, SUBSET_INTERVAL, GSYM REAL_NOT_LE] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH
   ``(a:real = -(b - c)) <=> (a + b = c)``] THEN
  MATCH_MP_TAC INTEGRAL_COMBINE THEN ASM_REWRITE_TAC[] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTEGRABLE_ON_SUBINTERVAL) THEN
  ASM_REWRITE_TAC[SUBSET_INTERVAL] THEN ASM_REAL_ARITH_TAC);

(* TODO: hol-light's "Multivariate/integration.ml", starting from line 21056:

   CONTINUOUS_BV_IMP_UNIFORMLY_CONTINUOUS
   HAS_BOUNDED_VARIATION_ON_DARBOUX_IMP_CONTINUOUS
   VECTOR_VARIATION_ON_INTERIOR
   VECTOR_VARIATION_ON_CLOSURE
   HAS_BOUNDED_VARIATION_IMP_BAIRE1
   INCREASING_IMP_BAIRE1
   DECREASING_IMP_BAIRE1
   FACTOR_THROUGH_VARIATION
   FACTOR_CONTINUOUS_THROUGH_VARIATION
   ...
 *)

val _ = export_theory();
